PDF to Excel: Pastes a Long String instead of Columns Shown
Often, when trying to copy/paste a PDF to excel, you get a string instead of columns
In the example below, the 2nd character after the decimal space is the position where the column would end
[Pattern Name][Price]
You can't do a find/replace on the Space character because the [Pattern Name] includes a space.
This method will take the string and convert it to the expected column format
(You will still need to run a TextToColumns after - Use "$" as the delimiter)
In the example below, the 2nd character after the decimal space is the position where the column would end
[Pattern Name][Price]
You can't do a find/replace on the Space character because the [Pattern Name] includes a space.
This method will take the string and convert it to the expected column format
(You will still need to run a TextToColumns after - Use "$" as the delimiter)
PDF String to Column Converter:
Sub PDF_ParseString_RepeatingPatternBasedOnOffsetMatch()
Dim aSplitMe As Variant, aDump() As Variant
Dim sReview As String, sDelimiter As String
Dim Ws1 As Long, iLoop As Long, iMark1 As Long, iMark2 As Long, sTempA As String, sTempB As String
Dim iUbound As Long, iCe1 As Long, iRe1 As Long
Dim sMarker As String, iNthCharAfterMatch As Long, iDump As Long
Dim bSplitMe As Boolean
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'Set the objects to be used:
Erase aDump
sReview = Cells(1, 1)
sMarker = "."
iNthCharAfterMatch = 2
sDelimiter = "^"
sTempA = ""
iDump = Application.InputBox(Prompt:="Click on a cell in the COLUMN where your want the results placed.", Title:="Specify Paste Cell by Clicking on ANY Cell.", Default:=ActiveCell.Address, Type:=8).Column
bSplitMe = False
Ws1 = ActiveSheet.Index
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
gLoadStringArray:
'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
For iLoop = 1 To Len(sReview)
'Find the Desired Character: Record the position of the Nth character after match within the string
If Mid(sReview, iLoop, 1) = "." Then sTempA = sTempA & iLoop + iNthCharAfterMatch & sDelimiter
Next iLoop
'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
'===================================================================================================
gCreateArrayUbound:
'Create a Ubound(Row) by getting a count of the Strings(sMarker) being searched for:
iUbound = Len(sReview) - Len(Replace(sReview, sMarker, "", , , vbTextCompare))
'===================================================================================================
gDefineArray:
'===================================================================================================
aDump = Range(Worksheets(Ws1).Cells(1, iDump + 1).Address, Worksheets(Ws1).Cells(iUbound, iDump + 1).Address)
'===================================================================================================
gParseDataUsingStringArray:
'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
'Split String
aSplitMe = Split(sTempA, "^")
'Preventing Memory cleanup error (Do not clean up memory if object not set)
bSplitMe = True
'Extract each chunk based on the defined pattern:
For iLoop = LBound(aSplitMe) To UBound(aSplitMe) - 1
'Mark the end position of the string
iMark2 = aSplitMe(iLoop)
'Extract and load into Array;
aDump(iLoop + 1, 1) = Trim(Mid(sReview, iMark1 + 1, iMark2 - iMark1 + 1))
'Create the Start Position for the next loop
iMark1 = iMark2
Next iLoop
'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
'===================================================================================================
Worksheets(Ws1).Select
Set Destination = Range(Worksheets(Ws1).Cells(1, iDump).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
gMemoryCleanup:
Erase aDump
If bSplitMe = True Then Erase aSplitMe
MsgBox "Finished:"
End Sub
Dim aSplitMe As Variant, aDump() As Variant
Dim sReview As String, sDelimiter As String
Dim Ws1 As Long, iLoop As Long, iMark1 As Long, iMark2 As Long, sTempA As String, sTempB As String
Dim iUbound As Long, iCe1 As Long, iRe1 As Long
Dim sMarker As String, iNthCharAfterMatch As Long, iDump As Long
Dim bSplitMe As Boolean
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'Set the objects to be used:
Erase aDump
sReview = Cells(1, 1)
sMarker = "."
iNthCharAfterMatch = 2
sDelimiter = "^"
sTempA = ""
iDump = Application.InputBox(Prompt:="Click on a cell in the COLUMN where your want the results placed.", Title:="Specify Paste Cell by Clicking on ANY Cell.", Default:=ActiveCell.Address, Type:=8).Column
bSplitMe = False
Ws1 = ActiveSheet.Index
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
gLoadStringArray:
'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
For iLoop = 1 To Len(sReview)
'Find the Desired Character: Record the position of the Nth character after match within the string
If Mid(sReview, iLoop, 1) = "." Then sTempA = sTempA & iLoop + iNthCharAfterMatch & sDelimiter
Next iLoop
'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
'===================================================================================================
gCreateArrayUbound:
'Create a Ubound(Row) by getting a count of the Strings(sMarker) being searched for:
iUbound = Len(sReview) - Len(Replace(sReview, sMarker, "", , , vbTextCompare))
'===================================================================================================
gDefineArray:
'===================================================================================================
aDump = Range(Worksheets(Ws1).Cells(1, iDump + 1).Address, Worksheets(Ws1).Cells(iUbound, iDump + 1).Address)
'===================================================================================================
gParseDataUsingStringArray:
'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
'Split String
aSplitMe = Split(sTempA, "^")
'Preventing Memory cleanup error (Do not clean up memory if object not set)
bSplitMe = True
'Extract each chunk based on the defined pattern:
For iLoop = LBound(aSplitMe) To UBound(aSplitMe) - 1
'Mark the end position of the string
iMark2 = aSplitMe(iLoop)
'Extract and load into Array;
aDump(iLoop + 1, 1) = Trim(Mid(sReview, iMark1 + 1, iMark2 - iMark1 + 1))
'Create the Start Position for the next loop
iMark1 = iMark2
Next iLoop
'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
'===================================================================================================
Worksheets(Ws1).Select
Set Destination = Range(Worksheets(Ws1).Cells(1, iDump).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
gMemoryCleanup:
Erase aDump
If bSplitMe = True Then Erase aSplitMe
MsgBox "Finished:"
End Sub