VBA: Delete empty rows based on value of cells

Solved/Closed
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022 - Updated on Oct 15, 2019 at 12:03 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Nov 4, 2019 at 11:35 AM
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

7 responses

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 15, 2019 at 12:02 PM
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
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Oct 15, 2019 at 01:49 PM
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
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 17, 2019 at 11:52 AM
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
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Oct 17, 2019 at 01:36 PM
there is no change the same thing this is what shows in sheet2


and this is my file
https://ufile.io/3jb6t9fe
0

Didn't find the answer you are looking for?

Ask a question
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 21, 2019 at 12:02 PM
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
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Oct 21, 2019 at 01:47 PM
what do you mean the run code ? what you want for me and fix which line code? i'm confused
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 22, 2019 at 11:33 AM
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.
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Oct 22, 2019 at 11:52 AM
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
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 22, 2019 at 11:58 AM
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
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Updated on Oct 22, 2019 at 01:00 PM
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
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 24, 2019 at 11:29 AM
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
0
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
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 31, 2019 at 12:43 PM
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
0
abdelfatah_0230 Posts 73 Registration date Thursday July 18, 2019 Status Member Last seen July 23, 2022
Oct 31, 2019 at 02:30 PM
thanks so much finally the code perfectly works i appreciate your efforts
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Nov 4, 2019 at 11:35 AM
Nice, thanks for the feedback!
0