VBA: Delete empty rows based on value of cells [Solved]

Posts
24
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 12, 2019
-
Hello,
my code works transfer my invoice from sheet1 to sheet 2 but my problem i would adjusted my code to become delete rows from a19: e32 if cells a19:a32=" " when press my macro becarful delete theses rows in sheet2 not sheet1 taking into consideration maybe occurs error in total the total =e33 and connected with last row filled data for instance the last row is a20:e20 so e33= e20
this is my code
Sub TransferData()

Dim Target As Range
Dim LastRow As Long
Dim R As Long

LastRow = sheet1.Cells(sheet1.Rows.Count, "A").End(xlUp).Row
Set Target = sheet2.Cells(sheet2.Rows.Count, "A").End(xlUp)
For R = 2 To LastRow
sheet1.Range(sheet1.Cells(R, 1), sheet1.Cells(R, 5)).Copy _
Destination:=Target.Offset(R - 2)
With Target.Offset(R - 2, 4)
If .HasFormula Then .Value = sheet1.Cells(R, 5).Value
End With
Next R

On Error Resume Next ' error if the is a REF error in the sum range
Target.Offset(R - 3, 5).Value = WorksheetFunction.Sum(sheet2.Range("E33:E35"))
End Sub
See more 

7 replies

Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370
0
Thank you
Hi Abdel,

Give the following code lines a try:
Dim cBlanks as Integer
cBlanks = WorksheetFunction.CountBlank(Range("A19:A32"))
If cBlanks = 14 then Range("A19:E32").ClearContents


Best regards,
Trowa
Respond to TrowaD
Posts
24
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 12, 2019
0
Thank you
it' doesn't work for more explenation
sheet 1 :


sheet2:





but what i would the result in sheet2:





note: as i said you earlier the total is connected with last row filled data
Respond to abdelfatah_0230
Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370
0
Thank you
Hi Abdel,

Quote
delete rows from a19: e32 if cells a19:a32=" "
Unquote

This is what the provided code lines were for.


Now I understand you want to delete single rows (row 19 to 31) in where there is no value in column A.
For that try the following:
Dim x As Integer
For x = 31 To 19 Step -1
    If Sheet2.Range("A" & x).Value = vbNullString Then Sheet2.Range("A" & x).EntireRow.Delete
Next x


Row 32 is excluded, since that is your total row.

Hopefully this is more to your liking.

Best regards,
Trowa
Respond to TrowaD
Posts
24
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 12, 2019
0
Thank you
there is no change the same thing this is what shows in sheet2


and this is my file
https://ufile.io/3jb6t9fe
Respond to abdelfatah_0230
Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370
0
Thank you
Hi Abdel,

I notice in your file that sheet 2 has the range 84:96 and sheet 1 has the mentioned 19:31. In your TransferData code you clean up sheet 1 before copying the data to sheet 2 (at the bottom of your range?).

To show you the provided code lines work as intended, I have added the code RunMe. Before running the code, select the first sheet (the one with a hidden grid). Since I can't reproduce your sheet names (it just ends up showing ????1) in the code, I used ActiveSheet as the sheet reference.

Here is your file:
https://ufile.io/qq1im9c6

Best regards,
Trowa
abdelfatah_0230
Posts
24
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 12, 2019
-
what do you mean the run code ? what you want for me and fix which line code? i'm confused
TrowaD
Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370 -
Running a code means the same as executing a code. Alt + F8 shows a list of macro codes, then double click "RunMe".

The code will check the active sheet if there are values in the range A19 to A31. When there in no value then the entire row will be deleted and then move on to check the column A value in the next row.

I'm a bit confused as well as you wanted the code to work for sheet2, but after looking at your file, sheet2 doesn't have data in the rows 19 to 31. Your sheet1 does have the data as shown in your screenshots. That is why I mentioned you might want to change sheet2 reference to sheet1.
abdelfatah_0230
Posts
24
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 12, 2019
-
to clear for your confusing when i said deleting from rows 19:31 not sheet1 because i need to fill data next time you note when i fill data in sheet1 and transfer to sheet2 it contains more than process this like archive to save many operation just i need transfer filling data sheet1 not empty as i said you based on condition to sheet2 the rows 19:31 is not relation sheet2

by the way your code is worked but not as i want
i hope this help to understand it
Respond to TrowaD
Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370
0
Thank you
For what I understand what you are trying to do is copy the table from sheet1 to sheet2 and then remove the empty rows.

The code to do that is:
Sub RunMe()
Sheets("Sheet2").Rows("83:96").Delete
Sheets("Sheet1").Rows("18:31").Copy Sheets("Sheet2").Rows("83")

Dim x As Integer
For x = 95 To 84 Step -1
    If Sheets("Sheet2").Range("A" & x).Value = vbNullString Then Sheets("Sheet2").Range("A" & x).EntireRow.Delete
Next x
End Sub


I have changed the sheet references to english, for me to work with.

To see it in action, check your file here (where I also added the formula =E21 to cell E31 of sheet1, which changes automatically to the corresponding cell on sheet2):
https://ufile.io/682hkgel

Hopefully that will clean up all the confusion that might be left.

Best regards,
Trowa
abdelfatah_0230
Posts
24
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 12, 2019
-
yes this is what i want the result attched file i'm really sorry to say that it's still problem when i press macro again it comes back the problem :


the first image
this is what i want


and when i press macro again it changes the past data and the new data come back the past problem

the past data become this:



the new data become this
TrowaD
Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370 -
Hi Abdel,

That is not the result I'm getting. Are you by any chance working on a Mac? That seems to mess with codes.

I did find a better formula for Sheet1 E31: =MIN(E19:E30). This way you don't have to change the formula every time the number of items changes.

Let us look at the code:
Sub RunMe()
Sheets("Sheet2").Rows("83:96").Delete
Sheets("Sheet1").Rows("18:31").Copy Sheets("Sheet2").Rows("83")

Dim x As Integer
For x = 95 To 84 Step -1
    If Sheets("Sheet2").Range("A" & x).Value = vbNullString Then Sheets("Sheet2").Range("A" & x).EntireRow.Delete
Next x
End Sub


Code line 2: The table is deleted from sheet2.
Code line 3: The table from sheet1 is copied to sheet2.
Code line 7: For each row in the table on sheet2, when column A is empty, then the row will be deleted.

So for a row NOT to be deleted, there must be something in column A.

Hopefully that creates some understanding of what is happening.

Best regards,
Trowa
your code is good but when i add a new data it supposes and shift after earlier data it shouldn't specify the range in sheet2 because for every time i would add a new data it supposes shift to a new rows not at the same ranges i need flexible range
Respond to TrowaD
Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370
0
Thank you
Hi Abdel,

Ok, so you want to keep the transfered data, when you transfer a new data table.

To be complete change the formula's on Sheet1:
E19: =Sheet1!$E$9-D19
E31: =MIN(E19:E30)

Then use the following code:
Sub RunMe()
Dim lRow As Integer

lRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row

Sheets("Sheet1").Range("A18:E31").Copy Sheets("Sheet2").Range("A" & lRow + 2)

Dim x As Integer
For x = lRow + 14 To lRow + 2 Step -1
    If Sheets("Sheet2").Range("A" & x).Value = vbNullString Then Sheets("Sheet2").Range("A" & x).EntireRow.Delete
Next x
End Sub


Best regards,
Trowa
abdelfatah_0230
Posts
24
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 12, 2019
-
thanks so much finally the code perfectly works i appreciate your efforts
TrowaD
Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370 -
Nice, thanks for the feedback!
Respond to TrowaD