Link to home
Start Free TrialLog in
Avatar of garethtnash
garethtnashFlag for United Kingdom of Great Britain and Northern Ireland

asked on

Excel Automation VBA

I had this question after viewing Excel VBA When using VLookup.

Hello All,

I have an excel file that downloads from a web server. The worksheet has columns a -> BM

I would like to automate the following

Delete Row 1
Sort by C1 (xxx Employee Number) ASC
Cut from C1 into B1 where B1 is NULL and C1 in NOT NULL
Delete Column C
Select each value in column B and Convert to Number
In Column BG delete all rows where BG is not "xxx" or "yyy"
In Column BM  add the following formula for each row   '=IF(AND(BK2 = BJ2, BE2 > 0), "Current","")'
Copy the formula down for each row of data
Delete each Row where BM = "" (i.e. only have current data left)

Any ideas?

Thank you
Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

you can record the macro that will automate the process that you posted above.
see how to this from Record Excel Macro
Possible,

If we gonna delete row1 then your headers will be deleted.

Please explain your header starts from row 2 or 1?

If possible, please upload sample workbook.
Avatar of garethtnash

ASKER

Hi Shums,

Currently row 2 contains the headers - row 1 has the name of the report :)

And attached is an example workbook (normally contains 1000s of rows)
ExampleReport.xlsx
Hi Gareth,

Please try below:
Sub Automation_VBA()
Dim Ws As Worksheet
Dim LR1 As Long, LR2 As Long
Dim r As Long
Dim i As Long
Dim Value$
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With
Set Ws = Worksheets("Sheet1")
LR1 = Ws.Range("C" & Rows.Count).End(xlUp).Row
'Delete row 1
Ws.Rows(1).Delete
'Sort on Column C
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range("E2:E" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Ws.Sort
    .SetRange Range("A1:BM" & LR1)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Copy Column C data to B
Ws.Range("C1:C" & LR1).Copy
Ws.Range("B1").PasteSpecial xlPasteValues

'Delete column C
Ws.Columns(3).Delete

'Convert Each Value in Column B and Covert to Number
With Ws.Range("B2:B" & LR1) 'Change As Needed
    .NumberFormat = "General"
    .Value = .Value
End With

'After deletion of column C, Column BG will become BF, to delete xxx & yyy
For r = LR1 To 2 Step -1
    Value = Ws.Cells(r, 58).Value
        If Not (Value Like "xxx" Or Value Like "yyy") Then
            Ws.Rows(r).Delete
        End If
Next
LR2 = Ws.Range("B" & Rows.Count).End(xlUp).Row

'After deletion of column C, Column BM will become BL, to add formula
Ws.Range("BL2:BL" & LR2).FormulaR1C1 = "=IF(AND(RC62 = RC61, RC56 > 0), ""Current"","""")"

'Delete blank cells in column BL
For i = LR2 To 2 Step -1
    If Ws.Cells(i, 64) = "" Then
        Ws.Rows(i).Delete
    End If
Next
Ws.Range("B2").Select
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With

End Sub

Open in new window


Delete Row 1
Sort by C1 (xxx Employee Number) ASC
Cut from C1 into B1 where B1 is NULL and C1 in NOT NULL
Delete Column C
Select each value in column B and Convert to Number
In Column BG delete all rows where BG is not "xxx" or "yyy"
In Column BM  add the following formula for each row   '=IF(AND(BK2 = BJ2, BE2 > 0), "Current","")'
Copy the formula down for each row of data
Delete each Row where BM = "" (i.e. only have current data left)

1. Delete Row 1 is fine
2. Sort C1(xxx Employee Number)ASC, its in Column B not Column C
3. Cut from C1 To B1 where B1 is NULL and C1 in NOT NULL : Column C is empty and B is Full
4. Select each value in column B and Convert to Number, your example is having alpha numeric Employee ID, what to convert to Number?
5. In Column BG delete all rows where BG is not "xxx" or "yyy". Column BG has just GGGGG nothing found of "xxx" or "yyy"
6. In Column BM  add the following formula for each row   '=IF(AND(BK2 = BJ2, BE2 > 0), "Current","")'
In Column BM you have time sheet submitted date, where would you want this formula?
Hi Shums

Thanks - it's a good start, but not quite there :(

So some thoughts

Can we do this first -

'Delete row 1
Ws.Rows(1).Delete

Open in new window


Then sort Column C - there will be Blank Cells, I only want to copy the cells that are not blank so -

Will this sort on column C ascending?

'Sort on Column C
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range("E2:E" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Ws.Sort
    .SetRange Range("A1:BM" & LR1)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Open in new window


Is this correct ? Range("E2:E" & LR1)

will this only select cells from Column C where data exists?

Set Ws = Worksheets("Sheet1")
LR1 = Ws.Range("C" & Rows.Count).End(xlUp).Row

Open in new window


Paste data in column B -

'Copy Column C data to B
Ws.Range("C1:C" & LR1).Copy
Ws.Range("B1").PasteSpecial xlPasteValues

Open in new window



Will this leave cells where the cell in C is blank?

If you can get me this far, I'll try the next - thank you
Hi Gareth,

I did followed your step

1st to delete first row
2nd to sort Column C by Employee ID
Please paste below, its a mistake from my part, I sort data in Column E
'Sort on Column C
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range("C2:C" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Ws.Sort
    .SetRange Range("A1:BM" & LR1)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Open in new window


Below code you can change which column has the data until the last row:
Set Ws = Worksheets("Sheet1")
LR1 = Ws.Range("C" & Rows.Count).End(xlUp).Row 'Change column as required

Open in new window

Below code is correct, it copies from C to B then deletes C
'Copy Column C data to B
Ws.Range("C1:C" & LR1).Copy
Ws.Range("B1").PasteSpecial xlPasteValues

Open in new window


Please let me know, you need some other changes
@garethtnash,

did you look at my post at #a41955098  and try to learn to do this?
Hi Rey,

Thanks, yes I know how to record a macro, however what I need to do here is actions based on cell / row values  - i.e. delete row if cell ah4 = ""

When you record a macro, it doesn't recognise that you are deleting rows 2, 4 and 12 because cell ah2, ah4 and ah 12 have a NULL value, just that you are deleting rows 2,4 and 12.

I need the logic to delete based on select queries.

Thanks
Gareth,

With the edited code, is my VBA helping you?
Hi Shums, it is but I'm struggling to pull it all together :)
Could you upload your workbook?
Sorry Shums,

I've not had a chance to look at this today, I'll upload tomorrow :)
Hi,

I've made good progress with the macro below -

Sub FGTS()
Set Ws = Worksheets("FG TS")
Ws.Rows(1).Delete
Rows("1:1").Select
Selection.Font.Bold = True
Selection.AutoFilter
 
    ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    Ws.Range("C2").Select
   Ws.Range(Selection, Selection.End(xlDown)).Select
    Ws.Range(Selection, Selection.End(xlDown)).Copy
    Ws.Range("B2").PasteSpecial xlPasteValues
    ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    'Ws.Range("B2").Select
    'Ws.Range(Selection, Selection.End(xlDown)).Select
   
    'With Ws.Range(B2, B2.End(xlDown))
    '.NumberFormat = "General"
    '.Value = .Value
    'End With
    Ws.Columns(3).Delete
    LR2 = Range("A" & Rows.Count).End(xlUp).Row
    Ws.Range("BM1").FormulaR1C1 = "Current TS?"
    Ws.Range("BM2:BM" & LR2).FormulaR1C1 = "=IF(AND(RC63 = RC62, RC57 > 0), ""Current"", """

Open in new window


However when I run this currently, I get a run-time error '424' object expected on the line below -

With Ws.Range(B2, B2.End(xlDown))

Open in new window



I'm also getting an issue with

Ws.Range("BM2:BM" & LR2).FormulaR1C1 = "=IF(AND(RC63 = RC62, RC57 > 0), ""Current"", """

Open in new window


'Its a run-time 424 again..

Any thoughts?

Thanks
Gareth,

It would be very helpful, if you upload your original workbook, because you are deleting one column before applying formula in BM Column, it should be followed step by step.

Else try below:
Sub Automation_VBA()
Dim Ws As Worksheet
Dim LR1 As Long, LR2 As Long
Dim r As Long
Dim i As Long
Dim Value$
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With
Set Ws = Worksheets("FG TS")
LR1 = Ws.Range("A" & Rows.Count).End(xlUp).Row
'Delete row 1
Ws.Rows(1).Delete
'Sort on Column C
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range("C2:C" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Ws.Sort
    .SetRange Range("A1:BM" & LR1)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Copy Column C data to B
Ws.Range("C1:C" & LR1).Copy
Ws.Range("B1").PasteSpecial xlPasteValues

'Delete column C
Ws.Columns(3).Delete

'Convert Each Value in Column B and Covert to Number
With Ws.Range("B2:B" & LR1) 'Change As Needed
    .NumberFormat = "General"
    .Value = .Value
End With

'After deletion of column C, Column BG will become BF, to delete xxx & yyy
For r = LR1 To 2 Step -1
    Value = Ws.Cells(r, 58).Value
        If Not (Value Like "xxx" Or Value Like "yyy") Then
            Ws.Rows(r).Delete
        End If
Next
LR2 = Ws.Range("A" & Rows.Count).End(xlUp).Row

'After deletion of column C, Column BM will become BL, to add formula
Ws.Range("BL2:BL" & LR2).FormulaR1C1 = "=IF(AND(RC62 = RC61, RC56 > 0), ""Current"","""")"

'Delete blank cells in column BL
For i = LR2 To 2 Step -1
    If Ws.Cells(i, 64) = "" Then
        Ws.Rows(i).Delete
    End If
Next
Ws.Range("B2").Select
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With

End Sub

Open in new window

Hi Shums,

Attached sample workbook, have made good progress except with the last bit of the code - it just loops and consumes resources -

Sub FGTS()
Set Ws = Worksheets("FG TS")
Ws.Rows(1).Delete
Rows("1:1").Select
Selection.Font.Bold = True
Selection.AutoFilter
 
    ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    Ws.Range("C2").Select
    Ws.Range(Selection, Selection.End(xlDown)).Select
    Ws.Range(Selection, Selection.End(xlDown)).Copy
    Ws.Range("B2").PasteSpecial xlPasteValues
    ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    'Ws.Range("B2").Select
    'Ws.Range(Selection, Selection.End(xlDown)).Select
   
    Range("B:B").Select 'specify the range which suits your purpose
    With Selection
        Selection.NumberFormat = "General"
        .Value = .Value
    End With
   
    Ws.Columns(3).Delete
    LR2 = Range("A" & Rows.Count).End(xlUp).Row
    Ws.Range("BM1").FormulaR1C1 = "Current TS?"
    Ws.Range("BM2:BM" & LR2).FormulaR1C1 = "=IF(AND(RC[-2] = RC[-3], RC[-8] > 0), ""Current"","""")"
   
    'Delete blank cells from column BM
    For i = LR2 To 2 Step -1
    If Ws.Cells(i, 65) = "" Then
    Ws.Rows(i).Delete
    End If
    Next
 
End Sub

Open in new window


Thank you
Book2.xlsx
ASKER CERTIFIED SOLUTION
Avatar of Shums Faruk
Shums Faruk
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Fantastic - thank you
You're welcome Gareth! Glad I was able to help.