Not repeating VBA code

Question

I have a VBA code, which is connected to a userform

The code searches the column headlines and fills in the columns with these headlines by taking the values from the userform

My question is: How can I avoid the repetition of the code?

Dim intBB As Integer
Dim rngBB As Range

intBB = 1

Do While ActiveWorkbook.Worksheets("Sheet1").Cells(1, intBB) <> ""
        If ActiveWorkbook.Worksheets("Sheet1").Cells(1, intBB).Value = "Block" Then
            With ActiveWorkbook.Worksheets("Sheet1")
                Set rngBB = .Range(.Cells(1, intBB), .Cells(1, intBB))

             End With
         Exit Do

        End If
          intBB = intBB + 1
    Loop

ActiveWorkbook.Worksheets("Sheet1").Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = BlockBox.Value

intBB = 1

Do While ActiveWorkbook.Worksheets("Sheet1").Cells(1, intBB) <> ""
        If ActiveWorkbook.Worksheets("Sheet1").Cells(1, intBB).Value = "HPL" Then
            With ActiveWorkbook.Worksheets("Sheet1")
                Set rngBB = .Range(.Cells(1, intBB), .Cells(1, intBB))

             End With
         Exit Do

        End If
          intBB = intBB + 1
    Loop

ActiveWorkbook.Worksheets("Sheet1").Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = HPLBox.Value

SJR · Accepted Answer · 2017-02-15 10:35:57Z

5

Maybe this? Adjust w1 and w2 accordingly.

Sub x()

Dim rngBB As Range
Dim v, w1, w2, i As Long

w1 = Array("Block", "HPL")
w2 = Array("Blockbox", "HPLBox")

For i = LBound(w1) To UBound(w1)
    With ActiveWorkbook.Worksheets("Sheet1")
        v = Application.Match(w1(i), .Rows(1), 0)
        If IsNumeric(v) Then
            Set rngBB = .Cells(1, v)
            .Range(.Cells(2, v), .Cells(LastRow, v)).Value = Me.Controls(w2(i)).Value
        End If
    End With
Next i

End Sub

answered Feb 15, 2017 at 10:35

SJR

23.1k6 gold badges21 silver badges26 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Vityata Over a year ago

Good for referring the controls in an array and reading them from there! :) I was too lazy to do it :)

SJR Over a year ago

@Vityata - thanks, I know that feeling! If the controls are all just the search term + 'Box' then can dispense with second array but didn't want to assume.

R3uK · Accepted Answer · 2017-02-15 10:38:14Z

Here is how to do it properly, by refactoring your code so that it's reusable easily :

Sub test_tombata()
    Dim wSh As Worksheet
    Set wSh = ActiveWorkbook.Sheets("Sheet1")

    Fill_Column_From_Header wSh, "Block", BlockBox.Value
    Fill_Column_From_Header wSh, "HPL", HPLBox.Value
End Sub

Using a sub to fill the column with the value :

Sub Fill_Column_From_Header(wS As Worksheet, HeaderName As String, ValueToFill As String)
    Dim LastRow As Double
    With wS
        LastRow = .Cells(.Rows.Count, intBB).End(xlUp).Row
        wSh.Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = ValueToFill
    End With 'wS
End Sub

Which use a function that gives you the column number from the Header Name :

Function Get_Column_From_Header(wS As Worksheet, HeaderName As String) As Integer
    Dim intBB As Integer
    intBB = 1
    Get_Column_From_Header = 0
    With wS
        Do While .Cells(1, intBB) <> ""
            If .Cells(1, intBB).Value <> HeaderName Then
            Else
                Get_Column_From_Header = intBB
                Exit Function
            End If
            intBB = intBB + 1
        Loop
    End With 'wS
End Function

I'd only add that if this code is in a regular module, you'd have to use :
USERFORMNAME.BlockBox.Value instead of just BlockBox.Value

Vityata · Accepted Answer · 2017-02-15 10:35:02Z

1

Try to do something like this:

dim wks     as worksheet

set wks = ActiveWorkbook.Worksheets("Sheet1")
With wks

    call LoopMe("Block", wks)
    .Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = BlockBox.Value

    call LoopMe("HPL", wks)
    .Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = HPLBox.Value

End with 



Public Sub LoopMe(strString as string, wks as worksheet)

    dim intBB as long : intBB = 1

    with wks
        Do While .Cells(1, intBB) <> ""
        If .Cells(1, intBB).Value = "Block" Then
            Set rngBB = .Range(.Cells(1, intBB), .Cells(1, intBB))
             Exit Do
        End If
          intBB = intBB + 1
        Loop
    end with

End Sub

edited Feb 15, 2017 at 10:35

answered Feb 15, 2017 at 10:29

Vityata

43.8k10 gold badges64 silver badges110 bronze badges

Collectives™ on Stack Overflow

Not repeating VBA code

3 Answers 3

2 Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

2 Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related