VBA to find column header through Msg Box

Hanes109 · May 29th 2021

Hi,

I'm looking for a VBA code to locate column header and fill the values till last available row.

Attached sample sheet for reference.

In the attached sheet,

1) Locate column header using msg box1 from the available sheets of workbook (Eg, Find "Truck1")

2) Enter value(msgbox 2) - 1250

3) Enter currency(msgbox 3) - AED

4) Value and currency should be updated till last available row.

Please share your suggestions.

Found the below code in forum but not sure what to update. Please help

Code

Public Sub FindAndUpdate()    
Dim i As Integer    
Dim lastRow As Long    
Dim myRng As Range    
Dim mycell As Range    
Dim MyColl As Collection    
Dim myIterator  As Variant
    Set MyColl = New Collection

MyColl.Add "Some Value"    
MyColl.Add "Another Value"
    lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlB Rows, SearchDirection:=xlPrevious).Row
    For i = 1 To 200        
      For Each myIterator In MyColl            
If Cells(1, i) = myIterator Then                
Set myRng = Range(Cells(2, i), Cells(lastRow, i))                For Each mycell In myRng                    
mycell.Value = Val(mycell.Value)               
Next            
End If        
Next    
Next
End Sub

Display More

Hanes109 · May 29th 2021

gijsmo and KjBox Please help..

**KjBox** · May 29th 2021

Try this.

Code

Option Explicit

Sub AddData()
    Dim x, xx, y, i As Long, sInput As String
    
    sInput = InputBox("Enter Header, Amount, Currency (separated by comma & a space)", "Data Entry")
    If sInput <> "" Then
        y = Split(sInput, ", ")
        With Sheet2.Cells(1).CurrentRegion
            x = .Resize(.Rows.Count + 1, .Columns.Count)
            xx = .Rows(1)
            i = Application.Match(y(LBound(y)), xx, 0)
            x(UBound(x, 1), 1) = "R" & UBound(x, 1) - 1
            x(UBound(x, 1), i) = Format(CDbl(y(LBound(y) + 1)), "#.00")
            x(UBound(x, 1), i + 1) = y(UBound(y))
            .Resize(.Rows.Count + 1, .Columns.Count) = x
        End With
    End If
    
End Sub

Display More

Your entry into the Input Box should be something like:

Truck4, 234.87, USD

Note you had "Truck1" in both cells A1 & A2, headers must be unique, I changed A1 to "Index"

Hanes109 · May 29th 2021

KjBox - That's amazing, Thank you so much for your response. but

1) I require the whole column to be updated the same value. ( Kindly refer the attachment - Required Output)

2) The macro should work on all the sheets from the active workbook. ( for eg: In attachment -Sheet 2 also it should work.)

**KjBox** · May 29th 2021

Sorry my mistake. Try this

Code

Option Explicit

Sub AddData()
    Dim x, xx, y, yy, i As Long, ii As Long, sInput As String, wbk as workbook

    set wbk =workbooks("S1")    'CHANGE AS REQUIRED

    sInput = InputBox("Enter Header, Truck, Amount, Currency (separated by comma & a space)", "Data Entry")
    
    If sInput <> "" Then
        y = Split(sInput, ", ")
        With Sheet1.Cells(1).CurrentRegion
            x = .Value
            xx = .Rows(1)
            i = Application.Match(y(LBound(y)), xx, 0)
            For ii = 2 To UBound(x, 1)
                x(ii, i) = Format(CDbl(y(LBound(y) + 2)), "#.00")
                x(ii, i + 1) = y(UBound(y))
            Next
            .Value = x
        End With
        With Sheet2.Cells(1).CurrentRegion
            x = .Value
            xx = .Rows(1)
            i = Application.Match(y(LBound(y) + 1), xx, 0)
            For ii = 2 To UBound(x, 1)
                x(ii, i) = Format(CDbl(y(LBound(y) + 2)), "#.00")
                x(ii, i + 1) = y(UBound(y))
            Next
            .Value = x
        End With
    End If
    
End Sub

Display More

The entry into the input Box should now be like: Header4, Truck4, 345.56, USD

I have indicated in the code where you will need to change it for the actual Name of your Output workbook (which needs to be open when the code is run from the Active workbook).

Hanes109 · May 29th 2021

No problem KjBox.

I'm getting error in the below code.

Code

i = Application.Match(y(LBound(y)), xx, 0)

Could you please tell what should I update.

**KjBox** · May 29th 2021

Is that in the sample workbook or your actual workbook?

What did you enter in the Input Box?

Hanes109 · May 29th 2021

I'm getting runtime-error 13.

Yes, In Sample workbook.

I entered "Truck7, 134, CAD".

**KjBox** · May 29th 2021

You forgot to enter the Header for Sheet 2, your entry should be

Header7, Truck7, 134, CAD

Hanes109 · May 29th 2021

Sorry KjBox, Macro works. But

My requirement is

Eg 1

"Truck7, 134, CAD"

Output:

Truck7	Truck7C
134	CAD

The above value should be dragged down till the last available row.

Eg2

"Header6, 256, AED"

Output:

Header6	Header6C
256	AED

Header and truck won't be same value. Hence it shouldn't be merged.

My workbook has 6 sheets with unique headers till (A1:KW1). So the macro will perform the search in all the sheets and find the header and the value with currency will be entered in whole column.

Sorry again.. I should have explained it clearly.

**KjBox** · May 29th 2021

Ok it is clearer now.

I think the best method would be to have an Input area on the Active workbook where you would enter all 6 Headers, Amounts and Currencies, then click a button to run the macro and update the Output Workbook

I will knock up an example and post it here (or you could attach your workbook which would be the Active workbook)

Hanes109 · May 29th 2021

In Simple terms, Macro works . But the combination is incorrect.

Header7, Truck7, 134, CAD - Incorrect.

Truck7, 134, CAD- Correct

Header7,174, USD - Correct

Hanes109 · May 29th 2021

Sure, Thanks for your suggestion. I will do the same.

Hanes109 · May 29th 2021

Attached the workbook..

**KjBox** · May 29th 2021

You said earlier that the code would be run from another (Active) workbook, do you now want an Input sheet in the same workbook as the Output Sheets instead?

Hanes109 · May 29th 2021

Quote

I think the best method would be to have an Input area on the Active workbook where you would enter all 6 Headers, Amounts and Currencies, then click a button to run the macro and update the Output Workbook

I thought you asked me to add input sheet. I don't require it. Msgbox works fine.

Your previous macro works but

I don't require this combo. - Header7, Truck7, 134, CAD

Required combination -

Example 1 - Truck7, 134, CAD

Example 2 - Header7, 154, USD

Example 3- Ducatti1, 156,AED

Macro will be running through personal macro workbook.

**KjBox** · May 29th 2021

Sorry, I thought you wanted all the sheets updating at the same time (but with different data).

Try this

Code

Option Explicit

Sub AddData()
    Dim x, xx, y, yy, i As Long, ii As Long, s As String, sSht As String
    Dim sInput As String, wbk As Workbook, ws As Worksheet
 
    Set wbk = Workbooks("S1")   'CHANGE AS REQUIRED
 
    sInput = InputBox("Enter Sheet, Header, Amount, Currency (separated by comma & a space)", "Data Entry")
 
    If sInput <> "" Then
        y = Split(sInput, ", ")
        sSht = y(LBound(y))
        Set ws = wbk.Sheets(sSht)
        With ws.Cells(1).CurrentRegion
            x = .Value
            xx = .Rows(1)
            i = Application.Match(y(LBound(y) + 1), xx, 0)
            For ii = 2 To UBound(x, 1)
                x(ii, i) = Format(CDbl(y(LBound(y) + 2)), "#.00")
                x(ii, i + 1) = y(UBound(y))
            Next
            .Value = x
        End With
     End If
 
End Sub

Display More

Change the workbook name as required. The 1st entry in the Input Box is now the Name of the sheet that needs updating, for example:

Sheet1, Truck4, 2345.67, AED

Hanes109 · May 29th 2021

You're the best KjBox. Thank you so much!!!!

**KjBox** · May 29th 2021

You're welcome.

Hanes109 · May 29th 2021

Quote

Sorry, I thought you wanted all the sheets updating at the same time (but with different data).

Is this even possible??

VBA to find column header through Msg Box

Participate now!

Share

Tags

Users Viewing This Thread