Results 1 to 13 of 13
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts

    Macro to extract specific Column Headings & Data

    I have a workbook called 40110.xls containing several sheets. I have another workbook called V Statements and need a macro in this workbook to extract the following column Headings and the data below these columns from the workbook 40110.xls. These headings do not appear in the same column on the various sheets. I also need the values under the amount column to be correctly formatted using "#,##0.00;(#,#00.00)"

    Doc.
    Number____________________________________________ ___________________________

    Doc.
    Date

    Amount

    I have attached the sample data of the raw data to be extracted as well as what it should look like after extraction-V Statements . Your assistance in this regard will be most appreciated
    Attached Files Attached Files

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    How about this?

    Steve

    Code:
    Option Explicit
    Sub ExtractData()
      Dim wksOutput As Worksheet
      Dim wkbSource As Workbook
      Dim wks As Worksheet
      Dim rng As Range
      Dim iColNumber As Integer
      Dim iColDate As Integer
      Dim iColAmt As Integer
      Dim lRowStart As Long
      Dim lRowEnd As Long
      Dim AWF As WorksheetFunction
      Dim bNeedHeader As Boolean
      Dim lRow As Long
      
      Set AWF = Application.WorksheetFunction
      Set wkbSource = ActiveWorkbook
      Workbooks.Add
      Set wksOutput = ActiveSheet
      bNeedHeader = True
      
      'work on each worksheet
      For Each wks In wkbSource.Worksheets
        With wks
          'Find number
          Set rng = .Cells.Find(What:="Number", After:=.Range("A1"), _
            LookIn:=xlFormulas, LookAt:=xlPart)
          iColNumber = rng.Column
          lRowStart = rng.Row + 1
          iColDate = AWF.Match("Date", .Rows(lRowStart - 1), 0)
          iColAmt = AWF.Match("Amount", .Rows(lRowStart - 2), 0)
          lRowEnd = wks.Cells(wks.Rows.Count, iColDate).End(xlUp).Row
          If bNeedHeader Then 'add header
            wksOutput.Range("A1:A2").Value = .Range(.Cells(lRowStart - 2, iColNumber), _
              .Cells(lRowStart - 1, iColNumber)).Value
            wksOutput.Range("B1:B2") = .Range(.Cells(lRowStart - 2, iColDate), _
              .Cells(lRowStart - 1, iColDate)).Value
            wksOutput.Range("c1:c2") = .Range(.Cells(lRowStart - 2, iColAmt), _
              .Cells(lRowStart - 1, iColAmt)).Value
            bNeedHeader = False ' header no longer needed
          End If
          lRow = wksOutput.Cells(.Rows.Count, 2).End(xlUp).Row + 1
          .Range(.Cells(lRowStart, iColNumber), _
            .Cells(lRowEnd, iColNumber)).Copy wksOutput.Cells(lRow, 1)
          .Range(.Cells(lRowStart, iColDate), _
            .Cells(lRowEnd, iColDate)).Copy wksOutput.Cells(lRow, 2)
          .Range(.Cells(lRowStart, iColAmt), _
            .Cells(lRowEnd, iColAmt)).Copy wksOutput.Cells(lRow, 3)
        End With
      Next
      With wksOutput
        .Range(.Cells(3, 3), _
          .Cells(.Rows.Count, 3).End(xlUp)).NumberFormat = "#,##0.00;(#,#00.00)"
      End With
      
      Set AWF = Nothing
      Set wksOutput = Nothing
      Set wkbSource = Nothing
      Set wks = Nothing
      Set rng = Nothing
    End Sub

  3. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for all your effort in writing the code-this is highly appreciated. The data has been extracted perfectly from workbook 40110. It would be appreciated if you would make 2 small changes:

    1) Would it be possible to have the Macro in V Statements as the file 40110 is received in PDF as I use a PDF to Excel converter to convert the file in Excel? If so kindly amend the macro to extract the data from the various sheets from the workbook 40110
    2) I need a macro that will format the values as "#,##0.00;(#,##0.00)" The value currently appear as for eg 4.384,24, 2.384,24- etc. These should appear as 4,384.24 , (2,384.24) etc

    Your assistance in this regard will be most appreciated

    Regards

    Howard


  4. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    How about this for number 2? (remove the red line if you want the dates to stay as text. The red line converts the text-date to real dates...

    Code:
    Option Explicit
    Sub ExtractData()
      Dim wksOutput As Worksheet
      Dim wkbSource As Workbook
      Dim wks As Worksheet
      Dim rng As Range
      Dim iColNumber As Integer
      Dim iColDate As Integer
      Dim iColAmt As Integer
      Dim lRowStart As Long
      Dim lRowEnd As Long
      Dim AWF As WorksheetFunction
      Dim bNeedHeader As Boolean
      Dim lRow As Long
      Dim rCell As Range
      
      Set AWF = Application.WorksheetFunction
      Set wkbSource = ActiveWorkbook
      Workbooks.Add
      Set wksOutput = ActiveSheet
      bNeedHeader = True
      
      'work on each worksheet
      For Each wks In wkbSource.Worksheets
        With wks
          'Find number
          Set rng = .Cells.Find(What:="Number", After:=.Range("A1"), _
            LookIn:=xlFormulas, LookAt:=xlPart)
          iColNumber = rng.Column
          lRowStart = rng.Row + 1
          iColDate = AWF.Match("Date", .Rows(lRowStart - 1), 0)
          iColAmt = AWF.Match("Amount", .Rows(lRowStart - 2), 0)
          lRowEnd = wks.Cells(wks.Rows.Count, iColDate).End(xlUp).Row
          If bNeedHeader Then 'add header
            wksOutput.Range("A1:A2").Value = .Range(.Cells(lRowStart - 2, iColNumber), _
              .Cells(lRowStart - 1, iColNumber)).Value
            wksOutput.Range("B1:B2") = .Range(.Cells(lRowStart - 2, iColDate), _
              .Cells(lRowStart - 1, iColDate)).Value
            wksOutput.Range("c1:c2") = .Range(.Cells(lRowStart - 2, iColAmt), _
              .Cells(lRowStart - 1, iColAmt)).Value
            bNeedHeader = False ' header no longer needed
          End If
          lRow = wksOutput.Cells(.Rows.Count, 2).End(xlUp).Row + 1
          .Range(.Cells(lRowStart, iColNumber), _
            .Cells(lRowEnd, iColNumber)).Copy wksOutput.Cells(lRow, 1)
          .Range(.Cells(lRowStart, iColDate), _
            .Cells(lRowEnd, iColDate)).Copy wksOutput.Cells(lRow, 2)
          .Range(.Cells(lRowStart, iColAmt), _
            .Cells(lRowEnd, iColAmt)).Copy wksOutput.Cells(lRow, 3)
        End With
      Next
      With wksOutput
        With .Range(.Cells(3, 3), .Cells(.Rows.Count, 3).End(xlUp))
          .NumberFormat = "#,##0.00;(#,#00.00)"
          .Replace What:=".", Replacement:="", LookAt:=xlPart
          .Replace What:=",", Replacement:=".", LookAt:=xlPart
          Set rng = .SpecialCells(xlCellTypeConstants, xlTextValues)
        End With
        .Range(.Cells(3, 2), .Cells(.Rows.Count, 2).End(xlUp)) _
          .Replace What:=".", Replacement:="/", LookAt:=xlPart
        For Each rCell In rng
          If Right(rCell, 1) = "-" Then
            rCell = Val("-" & Left(rCell, Len(rCell) - 1))
          End If
        Next
        .Columns("B:C").EntireColumn.AutoFit
      End With
      
      Set AWF = Nothing
      Set wksOutput = Nothing
      Set wkbSource = Nothing
      Set wks = Nothing
      Set rng = Nothing
    End Sub
    For the first question, I would need to see the VBA code that is currently used to convert the pdf to excel before I can incorporate it. If it is not VBA, you will have to find out from its author how to have VBA interact with it...

    Steve

  5. #5
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for the help, the data has been extracted correctly to a blank workbook

    As per Q1 in my post, I use a PDF converter to extract the raw data which has no macro. As your code is extracting the data corectly, would it not be possible to set up your Macro in V Statements and to pull the same info from 40110.xls into V Statements instaed of extracting it to a blank workbook? If so, it would be appreciated if you would amend the code so as to extract the data from 40110

    Regards

    Howard

  6. #6
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    How about this?
    And for educational purposes:
    The blue line is deleted (no need to add the new workbook)
    The green line is edit (assign the output to a new worksheet instead of a worksheet in the new workbook)
    The red lines are added (IF statement to only work on sheets that are NOT the one that was just added...)

    Steve
    Code:
    Option Explicit
    Sub ExtractData()
      Dim wksOutput As Worksheet
      Dim wkbSource As Workbook
      Dim wks As Worksheet
      Dim rng As Range
      Dim iColNumber As Integer
      Dim iColDate As Integer
      Dim iColAmt As Integer
      Dim lRowStart As Long
      Dim lRowEnd As Long
      Dim AWF As WorksheetFunction
      Dim bNeedHeader As Boolean
      Dim lRow As Long
      Dim rCell As Range
      
      Set AWF = Application.WorksheetFunction
      Set wkbSource = ActiveWorkbook
      'Workbooks.Add Delete this line
      Set wksOutput = Worksheets.Add
      bNeedHeader = True
      
      'work on each worksheet
      For Each wks In wkbSource.Worksheets
        If wks.Name <> wksOutput.Name Then
          With wks
            'Find number
            Set rng = .Cells.Find(What:="Number", After:=.Range("A1"), _
              LookIn:=xlFormulas, LookAt:=xlPart)
            iColNumber = rng.Column
            lRowStart = rng.Row + 1
            iColDate = AWF.Match("Date", .Rows(lRowStart - 1), 0)
            iColAmt = AWF.Match("Amount", .Rows(lRowStart - 2), 0)
            lRowEnd = wks.Cells(wks.Rows.Count, iColDate).End(xlUp).Row
            If bNeedHeader Then 'add header
              wksOutput.Range("A1:A2").Value = .Range(.Cells(lRowStart - 2, iColNumber), _
                .Cells(lRowStart - 1, iColNumber)).Value
              wksOutput.Range("B1:B2") = .Range(.Cells(lRowStart - 2, iColDate), _
                .Cells(lRowStart - 1, iColDate)).Value
              wksOutput.Range("c1:c2") = .Range(.Cells(lRowStart - 2, iColAmt), _
                .Cells(lRowStart - 1, iColAmt)).Value
              bNeedHeader = False ' header no longer needed
            End If
            lRow = wksOutput.Cells(.Rows.Count, 2).End(xlUp).Row + 1
            .Range(.Cells(lRowStart, iColNumber), _
              .Cells(lRowEnd, iColNumber)).Copy wksOutput.Cells(lRow, 1)
            .Range(.Cells(lRowStart, iColDate), _
              .Cells(lRowEnd, iColDate)).Copy wksOutput.Cells(lRow, 2)
            .Range(.Cells(lRowStart, iColAmt), _
              .Cells(lRowEnd, iColAmt)).Copy wksOutput.Cells(lRow, 3)
          End With
        End If
      Next
        With wksOutput
          With .Range(.Cells(3, 3), .Cells(.Rows.Count, 3).End(xlUp))
            .NumberFormat = "#,##0.00;(#,#00.00)"
            .Replace What:=".", Replacement:="", LookAt:=xlPart
            .Replace What:=",", Replacement:=".", LookAt:=xlPart
            Set rng = .SpecialCells(xlCellTypeConstants, xlTextValues)
          End With
        .Range(.Cells(3, 2), .Cells(.Rows.Count, 2).End(xlUp)) _
          .Replace What:=".", Replacement:="/", LookAt:=xlPart
        For Each rCell In rng
          If Right(rCell, 1) = "-" Then
            rCell = Val("-" & Left(rCell, Len(rCell) - 1))
          End If
        Next
        .Columns("B:C").EntireColumn.AutoFit
      End With
      
      Set AWF = Nothing
      Set wksOutput = Nothing
      Set wkbSource = Nothing
      Set wks = Nothing
      Set rng = Nothing
    End Sub

  7. #7
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for all the effort.

    The data is extracting correctly. However, the Values are not being formatted correctly for eg in workbook V Statements the value for Doc 200 should be formatted as 4,384.21, the value for doc201 should be (2,384.34) , the value for Doc 203 should be 31.40 etc i.e the formatting should be #,##0.00;(#,##0.00)" use the thousand seperator for 2 decimal places.

    Once the data has been extracted to V Statements (destination workbook) I would like a macro to delete the last sheet and to rename the first sheet "Sheet1"

    Your assistance will be most appreciated

    Regards

    Howard

    No code has to be inserted here.
    Attached Files Attached Files
    Last edited by HowardC; 2011-08-08 at 13:38.

  8. #8
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    The code I wrote already changes the text-amounts to numbers and formats in that manner, so I am not sure what the problem is...

    This code goes in V statements and you run it with 40110 (or whatever as the active file...

    Steve

    Code:
    Option Explicit
    Sub ExtractData()
      Dim wksOutput As Worksheet
      Dim wkbSource As Workbook
      Dim wks As Worksheet
      Dim rng As Range
      Dim iColNumber As Integer
      Dim iColDate As Integer
      Dim iColAmt As Integer
      Dim lRowStart As Long
      Dim lRowEnd As Long
      Dim AWF As WorksheetFunction
      Dim bNeedHeader As Boolean
      Dim lRow As Long
      Dim rCell As Range
      
      Set AWF = Application.WorksheetFunction
      Set wkbSource = ActiveWorkbook
      'Workbooks.Add Delete this line
      Set wksOutput = ThisWorkbook.Worksheets.Add
      bNeedHeader = True
      
      'work on each worksheet
      For Each wks In wkbSource.Worksheets
        With wks
          'Find number
          Set rng = .Cells.Find(What:="Number", After:=.Range("A1"), _
            LookIn:=xlFormulas, LookAt:=xlPart)
          iColNumber = rng.Column
          lRowStart = rng.Row + 1
          iColDate = AWF.Match("Date", .Rows(lRowStart - 1), 0)
          iColAmt = AWF.Match("Amount", .Rows(lRowStart - 2), 0)
          lRowEnd = wks.Cells(wks.Rows.Count, iColDate).End(xlUp).Row
          If bNeedHeader Then 'add header
            wksOutput.Range("A1:A2").Value = .Range(.Cells(lRowStart - 2, iColNumber), _
              .Cells(lRowStart - 1, iColNumber)).Value
            wksOutput.Range("B1:B2") = .Range(.Cells(lRowStart - 2, iColDate), _
              .Cells(lRowStart - 1, iColDate)).Value
            wksOutput.Range("c1:c2") = .Range(.Cells(lRowStart - 2, iColAmt), _
              .Cells(lRowStart - 1, iColAmt)).Value
            bNeedHeader = False ' header no longer needed
          End If
          lRow = wksOutput.Cells(.Rows.Count, 2).End(xlUp).Row + 1
          .Range(.Cells(lRowStart, iColNumber), _
            .Cells(lRowEnd, iColNumber)).Copy wksOutput.Cells(lRow, 1)
          .Range(.Cells(lRowStart, iColDate), _
            .Cells(lRowEnd, iColDate)).Copy wksOutput.Cells(lRow, 2)
          .Range(.Cells(lRowStart, iColAmt), _
            .Cells(lRowEnd, iColAmt)).Copy wksOutput.Cells(lRow, 3)
        End With
      Next
        With wksOutput
          With .Range(.Cells(3, 3), .Cells(.Rows.Count, 3).End(xlUp))
            .NumberFormat = "#,##0.00;(#,#00.00)"
            .Replace What:=".", Replacement:="", LookAt:=xlPart
            .Replace What:=",", Replacement:=".", LookAt:=xlPart
            Set rng = .SpecialCells(xlCellTypeConstants, xlTextValues)
          End With
        .Range(.Cells(3, 2), .Cells(.Rows.Count, 2).End(xlUp)) _
          .Replace What:=".", Replacement:="/", LookAt:=xlPart
        For Each rCell In rng
          If Right(rCell, 1) = "-" Then
            rCell = Val("-" & Left(rCell, Len(rCell) - 1))
          End If
        Next
        .Columns("B:C").EntireColumn.AutoFit
        With ThisWorkbook
          Application.DisplayAlerts = False
          .Worksheets(.Worksheets.Count).Delete
          Application.DisplayAlerts = True
        End With
        .Name = "Sheet1"
      End With
      
      Set AWF = Nothing
      Set wksOutput = Nothing
      Set wkbSource = Nothing
      Set wks = Nothing
      Set rng = Nothing
    End Sub

  9. #9
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for all the help so far. This is much appreciated.

    I think that I may have found where the problem lies. I removed the section of the macro that was inserted into the VBA module in V Statements to format the values in column C and then re-ran the macro. The values from the source workbook-40110 is pulled/extracted incorrectly. For Eg in Workbook 40110 the value for Doc 200 is 4.384,21 and this is extracted as 438,421.00 to V Statements before formatting-After formatting it should appear as 4,384.21.

    I have attached the source workbook 40110, the destination data in V Statements. I have also attached book2, which was extracted when running your first macro that was inserted in workbook 40110. This data was extracted correctly

    For some unkown reason the code that you wrote which I inserted into the VBA mode in V Statements is not extracting the values correctly
    It would be appreciated if you would test the macro in V Statements and make the necessary changes. Would it not be better to first clear the data in sheet1 in V Statements and then pull the data from 40110?

    Your assistance in this regard will be most appreciated

    Regards

    Howard
    Attached Files Attached Files

  10. #10
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    The code works for me on my machine....

    I suspect that the find and replace is acting differently on different machines and is probably due to the number formatting in windows.

    My machine reads the amounts as text (my machine uses comma as thousands separator and periods as decimal), so I remove the period separator and replace the comma decimal indicator with a period and excel then can tell its a number.

    If your machine reads the period as a separator and the comma as a decimal indicator, it probably does not need the find/replace to convert. Step through the code at the end and see when the text is converted to a number. You may have to remove some the find/replace statements.

    I can't troubleshoot, since the defaults are different...

    Steve

  11. #11
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for all the help. I am gouing to going your original code into the VBA module in the original workbook as it extracts perfectly. I hve tried a number of options in the destination workbook but cannot get the values to extract the corect data.

    Regards

    Howard

  12. #12
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    If you like some of the "newer items" that were added, you could add them to the original code. Or take the final code and just remove the find/replace comma and period (which is where I think the conversion is handled differently on your system than mine)

    Steve

  13. #13
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for the replt. Will amend code accordingly to suit my needs

    Regards

    Howard

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •