combine VBA statements

jmazorra

Well-known Member
Joined
Mar 19, 2011
Messages
715
Hello everyone:

At the moment I have 3 statements that i would like to streamline and combine into one. I would like to just press commandbutton1() and do the whole process rather than having 3 steps. Can I combine or I am better off doing it the way it is now?

Code:

Private Sub CommandButton1_Click()

'Prepare exports
'Delete cells and find and replace Y

Sheets("byemployee").Select
Rows("1:7").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("byposition").Select
Rows("1:7").Select
Selection.Delete Shift:=xlUp
Columns("E:E").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("I:I").Select
Selection.Replace What:="$", Replacement:="N", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("I:I").Select
Selection.Replace What:="", Replacement:="Y", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


MsgBox "Step 1 Completed"
End Sub

____________________________________________

Private Sub CheckBox7_Click()

'delete columns that are not referenced
Dim k, I As Long
With Sheets("byposition")
k = .UsedRange.Columns.Count
For I = k To 1 Step -1
Select Case LCase$(.UsedRange.Cells(1, I))
Case "job code", "functional area", "position title", "currency", "hourly base min", "hourly base mid", "hourly base max", _
"hourly mkt - 10th", "hourly mkt - 25th", "hourly mkt - 50th", "hourly mkt - 75th", "hourly mkt - 90th", "hourly at target", _
"mid to hourly target delta | %", "#ees", "annual base min", "annual base mid", "annual base max", "salary at target", _
"market percentile of salary mid", "annualized base min", "annualized base mid", "annualized base max", "annu. base mkt - 10th", _
"annu. base mkt - 25th", "annu. base mkt - 50th", "annu. base mkt - 75th", "annu. base mkt - 90th", "annu. base at target", "mid to annu. target delta | %"
'do nothing
Case Else
.UsedRange.Columns(I).Delete
End Select
Next I
End With
End Sub

________________________________________
Private Sub CheckBox8_Click()
'delete columns that are not referenced

Dim k, I As Long
With Sheets("byemployee")
k = .UsedRange.Columns.Count
For I = k To 1 Step -1
Select Case LCase$(.UsedRange.Cells(1, I))
Case "employee id", "position title", "job code", "employee name", "employee dept", "salary", "market percentile of base salary", _
"hourly rate", "market percentile of hourly rate", "annualized base pay", "market percentile of annu. base", "annual base min", _
"annual base mid", "annual base max", "salary compa-ratio", "salary range penetration", "hourly base min", "hourly base mid", _
"hourly base max", "hourly compa-ratio", "hourly range penetration", "annualized base min", "annualized base mid", "annualized base max", _
"annualized compa-ratio", "annualized range penetration", "target market-ratio"
'do nothing
Case Else
.UsedRange.Columns(I).Delete
End Select
Next I
End With
End Sub
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
try this:
Code:
Option Explicit

Private Sub CommandButton1_Click()
Dim k As Long, I As Long, ws As Worksheet

With Sheets("byposition")
    .Range("E:E").Copy .Range("A1")
    .Columns("I:I").Replace What:="$", Replacement:="N", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    .Columns("I:I").Replace What:="", Replacement:="Y", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End With

'Prepare exports
'Delete cells and find and replace Y
'delete columns that are not referenced

For Each ws In Sheets(Array("byemployee", "byposition"))
  With ws
    .Rows("1:7").Delete Shift:=xlUp
    .Cells.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    k = .UsedRange.Columns.Count
    
    For I = k To 1 Step -1
        Select Case LCase$(.UsedRange.Cells(1, I))
            Case "job code", "functional area", "position title", "currency", "hourly base min", "hourly base mid", "hourly base max", _
                 "hourly mkt - 10th", "hourly mkt - 25th", "hourly mkt - 50th", "hourly mkt - 75th", "hourly mkt - 90th", "hourly at target", _
                 "mid to hourly target delta | %", "#ees", "annual base min", "annual base mid", "annual base max", "salary at target", _
                 "market percentile of salary mid", "annualized base min", "annualized base mid", "annualized base max", "annu. base mkt - 10th", _
                 "annu. base mkt - 25th", "annu. base mkt - 50th", "annu. base mkt - 75th", "annu. base mkt - 90th", "annu. base at target", "mid to annu. target delta | %"
                    'do nothing
            Case Else
                .UsedRange.Columns(I).Delete
        End Select
    Next I
  End With
Next ws
        
End Sub
 
Upvote 0
I tried for 3 days and couldn't make it work. I guess it took a rocket scientist to figure it out ;).

Thanks
 
Upvote 0
try this:
Code:
Option Explicit
 
Private Sub CommandButton1_Click()
Dim k As Long, I As Long, ws As Worksheet
 
With Sheets("byposition")
    .Range("E:E").Copy .Range("A1")
    .Columns("I:I").Replace What:="$", Replacement:="N", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    .Columns("I:I").Replace What:="", Replacement:="Y", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End With
 
'Prepare exports
'Delete cells and find and replace Y
'delete columns that are not referenced
 
For Each ws In Sheets(Array("byemployee", "byposition"))
  With ws
    .Rows("1:7").Delete Shift:=xlUp
    .Cells.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    k = .UsedRange.Columns.Count
 
    For I = k To 1 Step -1
        Select Case LCase$(.UsedRange.Cells(1, I))
            Case "job code", "functional area", "position title", "currency", "hourly base min", "hourly base mid", "hourly base max", _
                 "hourly mkt - 10th", "hourly mkt - 25th", "hourly mkt - 50th", "hourly mkt - 75th", "hourly mkt - 90th", "hourly at target", _
                 "mid to hourly target delta | %", "#ees", "annual base min", "annual base mid", "annual base max", "salary at target", _
                 "market percentile of salary mid", "annualized base min", "annualized base mid", "annualized base max", "annu. base mkt - 10th", _
                 "annu. base mkt - 25th", "annu. base mkt - 50th", "annu. base mkt - 75th", "annu. base mkt - 90th", "annu. base at target", "mid to annu. target delta | %"
                    'do nothing
            Case Else
                .UsedRange.Columns(I).Delete
        End Select
    Next I
  End With
Next ws
 
End Sub


One last question. One of the columns that I choose to keep is the Currency. The problem is that these spreadsheets have 20 columns by that name I only need the first one, all others can be deleted. Can that be done by VBA? Another option would be to copy all Currency columns and paste at the end of the spreadsheet. Either idea would workl,

Thanks.
 
Upvote 0
That question is completely unrelated to the thread, FYI.

Code:
Dim CurFND as range, CurFIRST as Range, ws as Worksheet

On Error Resume Next
For each ws in Sheets(Array("byemployee", "byposition"))
   With ws
      Set CurFND = .Rows(1).Find("Currency", Lookin:=xlValues, LookAt:=xlwhole)
      If Not CurFND is Nothing Then
         Set CurFIRST = CurFND
         Do
            Set CurFND = .Rows(1).FindNext(CurFND)
            If CurFND.Address <> CurFIRST.Address Then 
               CurFND.EntireColumn.Delete xlShifttoLeft
            Else 
               Exit Do
            End If
         Loop
         Set CurFIRST = Nothing
         Set CurFND = Nothing
      End If
   End With
Next ws
 
Upvote 0

Forum statistics

Threads
1,223,566
Messages
6,173,106
Members
452,501
Latest member
musallam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top