put data in series by vba (MACRO CORRECTION)

[zyxw1234]

Hi Experts,
I am looking for a macro that do the things mentioned below

If column I of 1.xls matches with column B of H2.xlsb then put the data in series in that row

Macro will be placed in H2.xlsb



This is the variation of this post

Code: Select all

Sub Macrotest()
    Dim Ws1 As Worksheet, Ws2 As Worksheet, a, r As Range, x, myVal
    Dim Wb1 As Workbook, Wb2 As Workbook
    
    
    Set Wb1 = Workbooks.Open("C:\Users\**I've been banned**\Desktop\1.xls")
    Set Ws1 = Wb1.Worksheets.Item(1)
    Set Wb2 = ActiveWorkbook
    Set Ws2 = Wb2.Worksheets.Item(1)
    With Ws1
    a = .Cells(1).CurrentRegion.Columns("i").Value
    .Parent.Close False
End With
With Ws2
        For Each r In .Range("b2", .Range("b" & Rows.Count).End(xlUp))
            myVal = r.Value
            If Not IsNumeric(myVal) Then myVal = Chr(34) & myVal & Chr(34)
            x = Application.Match(r.Value, a, 0)
            If IsNumeric(x) Then
                With .Cells(r.Row, Columns.Count).End(xlToLeft)
                    .Cells(1, 2) = .Value + 1
                End With
            End If
        Next
    End With
End Sub

  
    Wb1.Close
    Wb2.Save
    
End Sub

Mr Jindon Sir has provided me the code but i modified the same as per my needs plz see the below link
https://www.excelforum.com/excel-progra ... ost5363466

[HansV]

So what is the problem?

[zyxw1234]

I modified the code but it's not perfect
Plz see my code & Jindon Sir Code
Jindon sir Code is perfect but I have issues with the path & sheet name
Path can be anything & anywhere & sheet name can be anything
So I needed the proper hard-coded of the same, So I tried to modified the code but some issues is there
Plz see my code HansV Sir & plz make the code perfect Sir

[HansV]

I cannot view the code on ExcelForum since I am not a member there.
But why don't you change the line

Code: Select all

    Set Wb2 = ActiveWorkbook

to open the workbook that you want to use? You have that in most of the other macros you have posted.

[zyxw1234]

Jindon Sir has given me this

Code: Select all

Sub test()
    Dim fn As String, a, r As Range, x, BK As String, myVal      
    fn = Application.GetOpenFilename("Excel Files,*.xls*")    'i want the path to be hardcoded in the macro & i will not select the file manually
    If fn = "False" Then Exit Sub
    With Workbooks.Open(fn).Sheets(1)
        a = .Cells(1).CurrentRegion.Columns("i").Value
        .Parent.Close False
    End With
    With Sheets("sheet1")
        For Each r In .Range("b2", .Range("b" & Rows.Count).End(xlUp))
            myVal = r.Value
            If Not IsNumeric(myVal) Then myVal = Chr(34) & myVal & Chr(34)
            x = Application.Match(r.Value, a, 0)
            If IsNumeric(x) Then
                With .Cells(r.Row, Columns.Count).End(xlToLeft)
                    .Cells(1, 2) = .Value + 1
                End With
            End If
        Next
    End With
End Sub

& sheet name can be anything so plz help me in making this code like that
This code works perfect only small changes is required as per my needs Sir

[zyxw1234]

Code: Select all

Set Wb2 = ActiveWorkbook

I used this bco'z macro will be placed in this file (H2.xlsb)

[HansV]

Remove the lines

Code: Select all

    fn = Application.GetOpenFilename("Excel Files,*.xls*")    'i want the path to be hardcoded in the macro & i will not select the file manually
    If fn = "False" Then Exit Sub

and in the line

Code: Select all

    With Workbooks.Open(fn).Sheets(1)

change fn to the path and filename of the workbook that you want to use.

[zyxw1234]

Code: Select all

With Workbooks.Open(fn).Sheets(1)

Instead of this


May I use this line HansV Sir

Code: Select all

With Workbooks.Open(fn).Item(1)

[HansV]

That is not valid VBA syntax. You have to replace fn with a string that specifies the path + filename of the workbook that you want to use.

[Doc.AElstein]

.Sheets(1) is usually = .Worksheets.Item(1) = .Worksheets(1)
That is referencing the first worksheet in 3 different ways ..

so you can do

Code: Select all

With Workbooks.Open(fn).Worksheets.Item(1)

instead of this

Code: Select all

With Workbooks.Open(fn).Sheets(1)

With Workbooks.Open(fn).Worksheets.Item(1)
is usually =
With Workbooks.Open(fn).Sheets(1)

Both are doing something with the first worksheet of the workbook that you open with Workbooks.Open(fn)

[zyxw1234]

Thnx Doc Sir & HansV Sir But macro is not giving perfect output
Plz see the file
Something is incorrect in the macro
It is not giving perfect output

[HansV]

Does this do what you want?

Code: Select all

Sub test()
    Dim fn As String, a, r As Range, x, BK As String, myVal
    fn = "1.xls"
    With Workbooks.Open(fn).Worksheets.Item(1)
        a = .Cells(1).CurrentRegion.Columns("i").Value
        .Parent.Close False
    End With
    With Worksheets.Item(1)
        For Each r In .Range("b2", .Range("b" & Rows.Count).End(xlUp))
            myVal = r.Value
            If Not IsNumeric(myVal) Then myVal = Chr(34) & myVal & Chr(34)
            x = Application.Match(r.Value, a, 0)
            If IsNumeric(x) Then
                With .Cells(r.Row, Columns.Count).End(xlToLeft)
                    ' *** CHANGED ***
                    If .Column = 2 Then
                        ' If we don't have a value yet, use 1
                        .Cells(1, 2) = 1
                    Else
                        ' Otherwise, increase by 1
                        .Cells(1, 2) = .Value + 1
                    End If
                    ' *** END OF CHANGE ***
                End With
            End If
        Next
    End With
End Sub

[zyxw1234]

No HansV Sir
After runing this macro, i am not getting any output sir

[HansV]

In order to run the macro, I removed the path from fn, please put it back in.

[zyxw1234]

Thnx Alot HansV Sir & Doc Sir for helping me in solving this problem
Have a Great Day
HansV Sir u understood the mistake in macro of my previous question (https://eileenslounge.com/viewtopic.php?f=30&t=34953)
So if u help me in the same then it will be a Great Help bco'z that problem is not solved yet & if not Sir then no issues Sir

[HansV]

Just read my replies in that thread, you will see what you have to do.

[zyxw1234]

i didn't understood ur tips what u said in that thread & thats y i was unable to solve the same HansV Sir

[HansV]

[zyxw1234]

No Problem Sir
Thnx Alot for ur Great Help

[zyxw1234]

Code: Select all

Sub test()
    Dim fn As String, a, r As Range, x, BK As String, myVal
    fn = "C:\Users\**I've been banned**\Desktop\1.xls"
    With Workbooks.Open(fn).Worksheets.Item(1)
        a = .Cells(1).CurrentRegion.Columns("i").Value
        .Parent.Close False
    End With
    With Worksheets.Item(1)
        For Each r In .Range("b2", .Range("b" & Rows.Count).End(xlUp))
            myVal = r.Value
            If Not IsNumeric(myVal) Then myVal = Chr(34) & myVal & Chr(34)
            x = Application.Match(r.Value, a, 0)
            If IsNumeric(x) Then
                With .Cells(r.Row, Columns.Count).End(xlToLeft)
                    ' *** CHANGED ***
                    If .Column = 2 Then
                        ' If we don't have a value yet, use 1
                        .Cells(1, 2) = 1
                    Else
                        ' Otherwise, increase by 1
                        .Cells(1, 2) = .Value + 1
                    End If
                    ' *** END OF CHANGE ***
                End With
            End If
        Next
    End With
End Sub

& in this one more thing is pending
after the process it should save the 1.xls & close all the files which is opened by the macro