Deleting Cells after Concatenation in VBA - excel

I am trying to reformat a text file that has been imported into Excel.
I have done several minor reformatting points including adding rows, deleting page numbers, and combining headlines back into a single cell via the & function (the text file was delimited when importing).
After a concatenate, in which I took certain cells from columns A-Z and combined them in Column A, I tried to delete the now redundant information from Columns B-Z.
I tried selecting the cells and deleting, and also Range.Clear, but it does not delete the cells. I receive no errors.
This is what I have to take care of this step:
'Fix Duplicate Cells from Concatenate
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(i, 1).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 26)).Clear
End If
Next
Ultimately, I would like to check if column A contains no information one row above the row where I would like to delete information from columns B-Z.
Full code:
Sub Format()
'This will delete page numbers
Dim lRow As Long
Dim iCntr As Long
lRow = 350
For iCntr = lRow To 1 Step -1
If IsNumeric(Cells(iCntr, 1)) Then
Rows(iCntr).Delete
End If
Next
'Add Row above each row with Headings
Dim lRow2 As Long, iRow As Long
With Worksheets("Sheet1")
lRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row in column A
'loop backwards (bottom to top = Step -1) through all rows
For iRow = lRow2 To 1 Step -1
'check if column A of current row (iRow) is "DIM"
If .Cells(iRow, "A").Value = "DIM" Then
.Rows(iRow).Resize(RowSize:=1).Insert xlShiftDown
'insert 1 row and move current (iRow) row down (xlShiftDown)
'means: insert 1 row ABOVE current row (iRow)
End If
Next iRow
End With
'Combine Headings back to single Cell
Dim lngLastRow As String
Dim lastRow As Long
Dim lastcolumn As Long
lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
For i = lastRow To 1 Step -1
If Cells(i, 1).Value = "DIM" Then
Cells(i, 1).Value = Cells(i, 1).Value & " " & Cells(i, 2).Value & " " & _
Cells(i, 3).Value & " " & Cells(i, 4).Value & " " & Cells(i, 5).Value & " " & _
Cells(i, 6).Value & " " & Cells(i, 7).Value & " " & Cells(i, 8).Value & " " & _
Cells(i, 9).Value & " " & Cells(i, 10).Value & " " & Cells(i, 11).Value & " " & _
Cells(i, 12).Value & " " & Cells(i, 13).Value & " " & Cells(i, 14).Value & " " & _
Cells(i, 15).Value & " " & Cells(i, 16).Value & " " & Cells(i, 17).Value & " " & _
Cells(i, 18).Value & " " & Cells(i, 19).Value & " " & Cells(i, 20).Value & " " & _
Cells(i, 21).Value & " " & Cells(i, 22).Value & " " & Cells(i, 23).Value & " " & _
Cells(i, 24).Value & " " & Cells(i, 25).Value & " " & Cells(i, 25).Value
End If
Next
'Fix Duplicate Cells from Concatenate
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(i, 1).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 26)).Clear
End If
Next
End Sub
The reason I have a condition set for the clearing of cells after concatenate is because I do not simply want to clear all cells in range B:Z, or even the specific rows in this range. I only want to clear this range in the instances where there is a blank line above it (headers to data). The reason being: I am trying to keep the spreadsheet as generic as possible in order to use it again if the specific layout of rows changes based on the input file.

First, the variable lastRow2 doesn't seem to be declared, and as you don't get any errors, you obviously don't use Option Explicit. Please do, because that will warn you about such errors.
Secondly, I don't see that you in any way initialize lastRow2, which explains why the loop is never run. Did you run the code in the debugger to verify values of variables and progress of the execution? That is the first thing to do when you see unexpected results.
Thirdly, I don't understand why you have the condition and why you use offset If IsEmpty(Range(i, 1).Offset(-1, 0)) = True. Just clear the cells explicitly
Try this instead:
lastColumn = 26
For i = lastRow To 1 Step -1
Range(Cells(i, 2), Cells(i, lastColumn)).Clear
Next
edit:
I noticed you have the last column as 25 (as well as the previous one) in the part where you concatenate the values from the cells. The correct last column is 26.
edit2:
Based on your edit of your question and assuming you have declared and initialized lastRow2 the corrected function would look like this:
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(Cells(i, 1), Cells(i, 1)).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 4)).Clear
End If
Next

Related

Add the sum of the total amount from the sheet

Thanks for opening my thread. I need help from you.
So in this sheet the total amount should be sum of fuel + surge + delivery_charge should be added in Total amount column.
Ex:- 1st order = 456777 this should add 109.49+303.41+25966.51 = 26379.41
2nd order = 23213213 should add 10+11318+65 = 11393
Dim i As Long, lastrow As Long, rng As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Cells(i, "A") <> "" Then
rng = Cells(i, "A").End(xlDown).Row - 1
Cells(i, "B").Value = WorksheetFunction.Sum(Range("C" & i & ":C" & rng), Range("E" & i & ":E" & rng), Range("G" & i & ":G" & rng))
End If
Next i
I'm getting output from this logic :
But the issue is for 2nd order id. It should take only that row. But here its taking 5th and 6th row for addition.
2nd order id= 23213213 total_amt should be 11393.
So anyone could you please help me to find out an issue.
Thanks and Regards,
Ranger
The issue is in how you find rng.
rng = Cells(i, "A").End(xlDown).Row - 1
You're using xlDown to find the start of the next block of data. This works as you'd expect, except where the data changes every cell. If you click on cell A5 and press CTRL-Shift-Down, you'll see that it selects three cells as it jumps to the end of that block of data (A7). This is normal Excel behaviour.
You could re-write your code to loop through all the data until it finds the right scenario, but in this case I believe the single cell issue can just be trapped with the right If statement.
If Cells(i + 1, "A") <> "" Then rng = i
Try this:
Dim i As Long, lastrow As Long, rng As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Cells(i, "A") <> "" Then
rng = Cells(i, "A").End(xlDown).Row - 1
If Cells(i + 1, "A") <> "" Then rng = i
Cells(i, "B").Value = WorksheetFunction.Sum(Range("C" & i & ":C" & rng), Range("E" & i & ":E" & rng), Range("G" & i & ":G" & rng))
End If
Next i

To Get only one raw of result for a particular Range

Following code is suggested by a helpful user, this works well to Calculate "From", "To", "MAX" etc values of a range. But this code gives results in every row of a range. I want to get the results in only first row of each row. Please help with this.
Sub trial()
Dim lastrow As Long
Dim destSht As Worksheet
Dim i As Long, j As Long
Set destSht = Worksheets("Final")
With Worksheets("Source")
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 2 To lastrow + 1 'loop whole range (column C)
If .Cells(i, "C") <> "" Then 'If column C is not empty then
For j = i To lastrow + 1 'Loop "group" range to find next empty cell. Start from current loop i to last row and add one row to get to next empty cell.
If .Cells(j, "C") = "" Then 'When next empty cell is found (i.e. end of small group range) then apply formulas
.Cells(i, "E").Value = .Cells(i, "B").Value 'From
.Cells(i, "F").Value = .Cells(j - 1, "B").Value 'To
.Cells(i, "G").Formula = "=MAX(C" & i & ":C" & j - 1 & ")" 'MAX
.Cells(i, "H").Formula = "=MIN(C" & i & ":C" & j - 1 & ")" 'MIN
.Cells(i, "I").Formula = "=AVERAGE(C" & i & ":C" & j - 1 & ")" 'AVG
Exit For
End If
Next j
End If
Next I
End With
End Sub
This Code gives following result
Desired Result
Try changing this line:
If .Cells(i, "C") <> "" Then 'If column C is not empty then
To this line:
If .Cells(i, "C") <> "" AND .Cells(i-1, "C") = "" Then 'If column C is not empty AND the column C above is empty then

Excel VBA snippet causing Run-Time Error '438'

1st time poster.
The following VBA script breaks a work macro everytime. I've tried different syntaxes to fix, but getting the same result.
The code is supposed to look through all data cells in column L, looking for the string, "ERROR". If found, copy that cell and the one to the right over to the correct column "AX" and clear the text in L and M.
The step it breaks at every time is the "Cells(i, 50).Paste" line.
Set rng = Application.Range("L4:M" & lrow)
For i = rng.Rows.Count To 4 Step -1
If Cells(i, 12).Value = "ERROR" Then
Range("L" & i & ":M" & i).Copy
Cells(i, 50).Paste
Range("L" & i & ":M" & i).ClearContents
End If
If Cells(i, 21).Value = "ERROR" Then
Rows(i).Delete
End If
Next I
Paste is not a method available to the Range object. Cells is a Range object. Ergo, "Object does not support this property or method" :)
You could try:
Cells(i, 50).PasteSpecial xlPasteAll
As #DavidZemens said, you missed the proper method name
furthermore your code seems to do unnecessary work where:
it first does something in current i row should If Cells(i, 12).Value = "ERROR" check return True
then it would delete the same i row should subsequent If Cells(i, 21).Value = "ERROR" Then return True again
Finally you're not using any PasteSpecial feature so you may want to use plain Copy one
Hence I'd refactor it as follows
Dim lrow As Long, i As Long
lrow = Cells(Rows.Count, "L").End(xlUp).Row
For i = lrow To 4 Step -1
If Cells(i, 21).value = "ERROR" Then
Rows(i).Delete
ElseIf Cells(i, 12).value = "ERROR" Then
Range("L" & i & ":M" & i).Copy Destination:=Cells(i, 50)
Range("L" & i & ":M" & i).ClearContents
End If
Next i

Troubles stopping my loop

Do While Cells(i, 1).Value <> ""
....
End If
i = i + 1
Loop
End Sub
Right. It works fine with numbers and stop perfectly. But With Text. It does not stop.
Ideally I want to stop at the last row of my content rather than my last row in Excel. I manage to make it work fine with numbers, but I cannot fix it with Text.
Any help would be great as I am a beginner in VBA.
Sub checkRoutine()
Dim i As Integer
Dim LastRow As Long
i = 1
Do While Cells(i, 1).Value <> ""
If IsNumeric(Cells(i, 1).Value) Then Cells(i, 2).Value = Cells(i, 1).Value & " " & Cells(7, 5).Value
If Not IsNumeric(Cells(i, 1).Value) Then
LastRow = Range("A" & Rows.Count).End(xlUp).row + 1
ActiveSheet.Cells(LastRow, "A").Value = Cells(i, 1).Value & " " & Cells(7, 5).Value
End If
i = i + 1
Loop
End Sub
As suggested by so many people, you need to change to use a For loop:
Sub checkRoutine()
Dim i As Long
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).row
For i = 1 To LastRow
If IsNumeric(Cells(i, 1).Value) Then
Cells(i, 2).Value = Cells(i, 1).Value & " " & Cells(7, 5).Value
Else
LastRow = Range("A" & Rows.Count).End(xlUp).row + 1
Cells(LastRow, "A").Value = Cells(i, 1).Value & " " & Cells(7, 5).Value
End If
Next
End Sub

If ID's match insert new row and total values in other columns

I have a spreadsheet that has about 19 columns and the amount of rows are always changing. Column A contains "Item IDs", column N contains "# of Items Sold", and column O contains "# of Items". I am trying to create a macro that inserts a row every time the "Item ID" in column A changes, and totals up the "# of Items Sold" as well as the "# of Items". I would also like to copy the "Item ID" into this new row if possible. If anybody could help me with this I would be VERY appreciative.
UPDATE: See below for screenshots of the spreadsheet example (I tried to post images but since I'm new I guess I don't have this level of access yet).
How the spreadsheet looks now:
How I would like the spreadsheet to look after running the macro:
The best option for you would be Data ► Subtotal. It's the least time consuming.
Before:
1. Subtotal is in Outline group:
2. Details:
After:
ZygD, I appreciate your help. I really was looking for a macro as this is just one of probably 7 or so macro's that are going to be tied into a one button solution for somebody else who doesn't have the time/knowledge to subtotal these rows.
I came up with a macro that copied the spreadsheet to a temp sheet. In that temp sheet it adds a gray row every time the ID changes, and subtotals the 2 aforementioned columns... while copying all the other info down. However, this caused Excel to freeze up for a while... so instead I had it delete all columns except the ones I needed, subtotal, & delete all rows except the one's that are gray (subtotaled). Here's the macro I came up with (in case anybody else is looking for something similar):
Sub SubTotal()
Dim i As Long
Dim numberOfRows As Long
Dim j
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Copies SellerTotals to SellerTotals(Temp)
Sheets("SellerTotals").Select
Sheets("SellerTotals").Copy Before:=Sheets("Pacing")
Sheets("SellerTotals (2)").Select
Sheets("SellerTotals (2)").Name = "SellerTotals(Temp)"
Worksheets("SellerTotals(Temp)").Activate
Range("B:M,P:T").Select
Selection.Delete Shift:=xlToLeft
' number of IDs
numberOfRows = Cells(Rows.Count, "A").End(xlUp).Row
' do bottom row first
Cells(numberOfRows + 1, 1).Value = Cells(numberOfRows, 1).Value
Cells(numberOfRows + 1, 2).FormulaR1C1 = "=SUMIF(R[-" & numberOfRows - 1 & "]C[-1]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[-1],""" & Cells(numberOfRows, 1).Value & """,R[-" & numberOfRows - 1 & "]C[0]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[0])"
Cells(numberOfRows + 1, 3).FormulaR1C1 = "=SUMIF(R[-" & numberOfRows - 1 & "]C[-2]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[-2],""" & Cells(numberOfRows, 1).Value & """,R[-" & numberOfRows - 1 & "]C[0]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[0])"
' convert to value
Cells(numberOfRows + 1, 2).Value = Cells(numberOfRows + 1, 2).Value
Cells(numberOfRows + 1, 3).Value = Cells(numberOfRows + 1, 3).Value
Range(Cells(numberOfRows + 1, 1), Cells(numberOfRows + 1, 3)).Interior.Color = RGB(192, 192, 192)
' insert blank row in between each group of IDs
' loop backwards because we are inserting rows
For i = numberOfRows To 3 Step -1
If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
Cells(i, 1).EntireRow.Insert xlShiftDown
' copy ID name down
Cells(i, 1).Value = Cells(i - 1, 1).Value
' put formula into Total & Total Cap field
Cells(i, 2).FormulaR1C1 = "=SUMIF(R[-" & i - 1 & "]C[-1]:R[-" & i - (i - 1) & "]C[-1],""" & Cells(i, 1).Value & """,R[-" & i - 1 & "]C[0]:R[-" & i - (i - 1) & "]C[0])"
Cells(i, 3).FormulaR1C1 = "=SUMIF(R[-" & i - 1 & "]C[-2]:R[-" & i - (i - 1) & "]C[-2],""" & Cells(i, 1).Value & """,R[-" & i - 1 & "]C[0]:R[-" & i - (i - 1) & "]C[0])"
' convert to value
Cells(i, 2).Value = Cells(i, 2).Value
Cells(i, 3).Value = Cells(i, 3).Value
Range(Cells(i, 1), Cells(i, 3)).Interior.Color = RGB(192, 192, 192)
End If
Next i
' Delete Blank Rows
For j = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(j, 1).Interior.Color <> RGB(192, 192, 192) Then Cells(j, 1).EntireRow.Delete
Next j
End Sub

Resources