Link to home
Create AccountLog in
Avatar of Shums Faruk
Shums FarukFlag for India

asked on

Insert single row between data

Hi All,

I have been looking for subject vba code and found many, but non matches my goal. Its quiet simple could anyone help me? Please.

On monthly basis I update my GL file, from there I need to pull current month data in Column C, I need help of inserting blank row in Column B, insert current month and copy the data from source file into column C as per header which is in column A. These headers would be approximately 100, in attached file I have just added two. Highlighted Yellow cells are manual entries which changes yearly.

Hope any one of you understood my situation and requirement.

Please response favorably.
GL-Recon.xlsx
GL-Source.xlsx
Avatar of Saqib Husain
Saqib Husain
Flag of Pakistan image

Try this macro
Sub postdata()
    Dim swb As Workbook, twb As Workbook, wb As Workbook
    Dim sws As Worksheet, tws As Worksheet
    Dim tl As Range, cel As Range
    For Each wb In Application.Workbooks
        If wb.ActiveSheet.Range("A1") = "PCNT" Then
            Set twb = wb
            Set tws = wb.ActiveSheet
        End If
        If wb.ActiveSheet.Range("A1") = "Seq" Then
            Set swb = wb
            Set sws = wb.ActiveSheet
        End If
    Next wb
    For Each cel In sws.Range("D2:D" & sws.Range("D2").End(xlDown).Row)
        Set tl = tws.Range("A:A").Find(cel, , , xlWhole)
        If tl Is Nothing Then
            MsgBox (cel.Value & " " & cel.Offset(, -2) & "  Not found")
        Else
            Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
            tl.EntireRow.Insert
            tl.Offset(-1) = DateSerial(2012, cel.Offset(, -1), 1)
            tl.Offset(-1, 1) = cel.Offset(, 1)
        End If
    Next cel
End Sub

Open in new window

This will select the source and destination files (both should be open with the relevant sheets active) on the basis of the content in cell A1 of the active sheets.
Avatar of Shums Faruk

ASKER

Thanks Saqibh,

It works fine, but its popping msg box for every list in GL_Source, can we lessen this msg box and identify just the PCNT of GL_Recon?
To disable the msg box just delete or comment out the line.

Please explain how do you want to identify the PCNT of GL_Recon?
Saqib,

I am not aware of disabling the msg box.

I would like to identify only the existing PCNT in GL_Recon and the the data from GL_Source.
Saqib,

I wish I wouldn't need to open source file and open it through vba, pull data and close source file..
I am not sure I understand what you want now.

If you want no message box then use this code. It will insert lines for the available codes. If that code is not found in recon it will ignore it.
Sub postdata()
    Dim swb As Workbook, twb As Workbook, wb As Workbook
    Dim sws As Worksheet, tws As Worksheet
    Dim tl As Range, cel As Range
    For Each wb In Application.Workbooks
        If wb.ActiveSheet.Range("A1") = "PCNT" Then
            Set twb = wb
            Set tws = wb.ActiveSheet
        End If
        If wb.ActiveSheet.Range("A1") = "Seq" Then
            Set swb = wb
            Set sws = wb.ActiveSheet
        End If
    Next wb
    For Each cel In sws.Range("D2:D" & sws.Range("D2").End(xlDown).Row)
        Set tl = tws.Range("A:A").Find(cel, , , xlWhole)
            Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
            tl.EntireRow.Insert
            tl.Offset(-1) = DateSerial(2012, cel.Offset(, -1), 1)
            tl.Offset(-1, 1) = cel.Offset(, 1)
    Next cel
End Sub

Open in new window

Saqib,

I am getting error for line 17.

I would like to have application.open in above vba to open source file, run above code and close GL_Source file.
Sorry
Sub postdata()
    Dim swb As Workbook, twb As Workbook, wb As Workbook
    Dim sws As Worksheet, tws As Worksheet
    Dim tl As Range, cel As Range
    For Each wb In Application.Workbooks
        If wb.ActiveSheet.Range("A1") = "PCNT" Then
            Set twb = wb
            Set tws = wb.ActiveSheet
        End If
        If wb.ActiveSheet.Range("A1") = "Seq" Then
            Set swb = wb
            Set sws = wb.ActiveSheet
        End If
    Next wb
    For Each cel In sws.Range("D2:D" & sws.Range("D2").End(xlDown).Row)
        Set tl = tws.Range("A:A").Find(cel, , , xlWhole)
        If tl Is Nothing Then
        Else
            Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
            tl.EntireRow.Insert
            tl.Offset(-1) = DateSerial(2012, cel.Offset(, -1), 1)
            tl.Offset(-1, 1) = cel.Offset(, 1)
        End If
    Next cel
End Sub

Open in new window

Saqib,

This works perfect, could you please advice code for opening a source file, select and run above code?
Sorry I forgot to tell you that I get GL_Source on monthly basis, so for October it would be GL_Source_Oct.xls and for November it would be GL_Source_Nov.xls.

I would like to have Workbooks.Open(Thisworkbook.Path & "\GL_Source*" & ".xls")
How do you know which month to open? If it is the current month then try this. I have not tested this

Sub postdata()
    Dim swb As Workbook, twb As Workbook, wb As Workbook
    Dim sws As Worksheet, tws As Worksheet
    Dim tl As Range, cel As Range
            Set twb = application.activeworkbook
            Set tws = wb.ActiveSheet
            Set swb = application.workbooks.open("GL_Source_" & format(month(date)) & ".xls")
            Set sws = wb.ActiveSheet
        End If
    Next wb
    For Each cel In sws.Range("D2:D" & sws.Range("D2").End(xlDown).Row)
        Set tl = tws.Range("A:A").Find(cel, , , xlWhole)
            Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
            tl.EntireRow.Insert
            tl.Offset(-1) = DateSerial(year(date), cel.Offset(, -1), 1)
            tl.Offset(-1, 1) = cel.Offset(, 1)
    Next cel
End Sub
Saqib,

I would like to open for current month and the format for current month is GL_Source10_111212. Where 10 stands for October data 11 stands for current month 12 stands for the date GL_Source extracted and again 12 stands for Year. Can we just have open filename option instead of specifying the current month?
In that case I would suggest that you open only these two workbooks and use this code
Sub postdata()
    Dim swb As Workbook, twb As Workbook, wb As Workbook
    Dim sws As Worksheet, tws As Worksheet
    Dim tl As Range, cel As Range
    For Each wb In Application.Workbooks
        If wb.ActiveSheet.Range("A1") = "PCNT" Then
            Set twb = wb
            Set tws = wb.ActiveSheet
        else
            Set swb = wb
            Set sws = wb.ActiveSheet
        End If
    Next wb
    For Each cel In sws.Range("D2:D" & sws.Range("D2").End(xlDown).Row)
        Set tl = tws.Range("A:A").Find(cel, , , xlWhole)
        If tl Is Nothing Then
        Else
            Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
            tl.EntireRow.Insert
            tl.Offset(-1) = DateSerial(2012, cel.Offset(, -1), 1)
            tl.Offset(-1, 1) = cel.Offset(, 1)
        End If
    Next cel
End Sub

Open in new window

Thanks Saqib,

What if we create separate sub for opening file and then run postdata? then too only these two files will be active sheet.
Try this

Sub postdata()
    Dim swb As Workbook, twb As Workbook, wb As Workbook
    Dim sws As Worksheet, tws As Worksheet
    Dim tl As Range, cel As Range
            Set twb = application.activeworkbook
            Set tws = wb.ActiveSheet
            Set swb = application.workbooks.open(application.getopenfilename)
            Set sws = wb.ActiveSheet
        End If
    Next wb
    For Each cel In sws.Range("D2:D" & sws.Range("D2").End(xlDown).Row)
        Set tl = tws.Range("A:A").Find(cel, , , xlWhole)
            Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
            tl.EntireRow.Insert
            tl.Offset(-1) = DateSerial(year(date), cel.Offset(, -1), 1)
            tl.Offset(-1, 1) = cel.Offset(, 1)
    Next cel
End Sub
No, its not working. I tried this way and its working perfectly.

Sub OpenFile()

Workbooks.Open (ThisWorkbook.Path & "\GL_Source_" & Format(Month(Date)) & ".xlsx")

End Sub

Open in new window

Sub PostData()
    Dim swb As Workbook, twb As Workbook, wb As Workbook
    Dim sws As Worksheet, tws As Worksheet
    Dim tl As Range, cel As Range
    Call OpenFile
    For Each wb In Application.Workbooks
        If wb.ActiveSheet.Range("A1") = "PCNT" Then
            Set twb = wb
            Set tws = wb.ActiveSheet
        End If
        If wb.ActiveSheet.Range("A1") = "Seq" Then
            Set swb = wb
            Set sws = wb.ActiveSheet
        End If
    Next wb
    For Each cel In sws.Range("D2:D" & sws.Range("D2").End(xlDown).Row)
        Set tl = tws.Range("A:A").Find(cel, , , xlWhole)
        If tl Is Nothing Then
        Else
            Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
            tl.EntireRow.Insert
            tl.Offset(-1) = DateSerial(2012, cel.Offset(, -1), 1)
            tl.Offset(-1, 1) = cel.Offset(, 1)
        End If
    Next cel
    ActiveWorkbook.Close
End Sub

Open in new window

No, its not working
In what way?
End If without If statement and next wb

Set twb = application.activeworkbook
            Set tws = wb.ActiveSheet
            Set swb = application.workbooks.open(application.getopenfilename)
            Set sws = wb.ActiveSheet
        End If
    Next wb
Sorry
Sub postdata()
    Dim swb As Workbook, twb As Workbook, wb As Workbook
    Dim sws As Worksheet, tws As Worksheet
    Dim tl As Range, cel As Range
            Set twb = application.activeworkbook
            Set tws = twb.ActiveSheet
            Set swb = application.workbooks.open(application.getopenfilename)
            Set sws = swb.ActiveSheet
    For Each cel In sws.Range("D2:D" & sws.Range("D2").End(xlDown).Row)
        Set tl = tws.Range("A:A").Find(cel, , , xlWhole)
            Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
            tl.EntireRow.Insert
            tl.Offset(-1) = DateSerial(year(date), cel.Offset(, -1), 1)
            tl.Offset(-1, 1) = cel.Offset(, 1)
    Next cel
End Sub 

Open in new window

Now its giving error at line 11
Set tl = tl.Offset(, 1).End(xlDown).Offset(1)
ASKER CERTIFIED SOLUTION
Avatar of Saqib Husain
Saqib Husain
Flag of Pakistan image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Thanks Saqib for your this much time. It was really good help, you are simply superb.

By the way whats your name? & where are you from? If I may ask?
You can check my profile.

Thanks for the points and the grade.