PDA

View Full Version : Formatting question



austenr
04-01-2020, 10:32 AM
This seems simple to solve but its not. I get a file exported from a system that evidently get a text file and loads it into excel as csv formatted.

What I am trying to do is take a column from this file which is formatted as general and paste it into another workbook where I have a macro to loop through the column I pasted from the previously mentioned file and find the cells that total an amount in a cell. The cells in the new workbook are formatted as general.

This will not find the matching cells formatted as is from the exported file. However, if I type in the values in the cells and run the macro I get the expected results.

I've tried all kinds of formatting, used the trim function etc to no avail. My question is why does it work if I type in the numbers and not from pasting the values?

Paul_Hossler
04-01-2020, 11:05 AM
Post a small sample file

austenr
04-01-2020, 11:40 AM
Hi Paul,.

File A is what is generated from the system in a csv format so I left it that way (feel free to use either col in file A). File B is the workbook that I have with the macro in it. Like I said I pasted a similar column from another file A into my File B workbook, ran the macro and got the box telling me "No match". However if I replace the numbers in col A in file B where I type in the numbers it will find a match. So if you want to run the macro and put in whatever numbers you want to find manually it works. Thanks for the response.

austenr
04-02-2020, 11:05 AM
Im going to post this sample workbook in hopes that someone will have an idea why this macro doesnt work. I picked a few numbers from Col A and took that total and put it in the Blue box then clicked the find matching invoices button. At the end I get the "No Matches" dialogue box but Im guessing that there are some sort of special characters or blanks in the cells in column A as it is a C&P from a csv workbook.. The macro should run and place the numbers under X,Y or Z.

Been beating my brains out over this but cant figure it out. Also, if you manually type in the numbers in Col A it works as expected leading me to believe that there is junk in Col A preventing a match.

Paul_Hossler
04-02-2020, 01:11 PM
I was working with the other files you posted

I'm not sure why this isn't correct, based on what I thought you were looking for

I'm not sure why you clear the Col A numbers

26261


My biggerest question is trying to figure out exactly what you want to do. Why the random numbers?

I had to reformat to add lines and indents to try to follow, but the logic still wasn't obvious





Option Explicit


Private Sub Button1_Click()
Dim LastRow As Long, Cnt As Long


Cnt = 1

With Sheets("Sheet1")

Do Until CheckCheques2("A", "B", .Range("C2").Value) Or Cnt = 200
Cnt = Cnt + 1
Loop


If Cnt < 200 Then
MsgBox "DONE. Iterations: " & Cnt

'clear input
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'????? .Range("A2:A" & LastRow).Clear


Else
MsgBox "NO MATCH"
End If

End With


End Sub


Public Function CheckCheques2(InCol As String, OutCol As String, InRng As Range) As Boolean


Dim LastRow As Long, LoopCnt As Double, RowNum As Long, TotNum As Double, Cnt As Long
Dim Arr() As Variant, ArCnt As Long, LetterArr() As Variant, LetCnt As Long
Dim ColCnt As Long, RowCnt As Long


With Sheets("Sheet1")
LastRow = .Range(InCol & .Rows.Count).End(xlUp).Row

If LastRow = 1 Then Exit Function

.Range(OutCol & "2:" & OutCol & LastRow).Clear
.Range("E8:G100").Clear
.Range("E7") = "X"
.Range("F7") = "Y"
.Range("G7") = "Z"


LetCnt = 0
ArCnt = 0
LetterArr = Array("X", "Y", "Z")

Randomize

above:
LoopCnt = LoopCnt + 1

'change iterations to suit
If LoopCnt = 1000 Or LetCnt = 3 Then Exit Function

getnewrow:
RowNum = Int((LastRow * Rnd) + 1)

If RowNum <> 1 Then
If ArCnt <> 0 Then
For Cnt = LBound(Arr) To UBound(Arr)
If Arr(Cnt) = RowNum Then GoTo above
Next Cnt
End If

'exclude blank cells
If .Range(InCol & RowNum) = vbNullString Then GoTo getnewrow

TotNum = TotNum + CDbl(.Range(InCol & RowNum))
If TotNum = InRng.Value Then
CheckCheques2 = True
ArCnt = ArCnt + 1

ReDim Preserve Arr(ArCnt)
Arr(ArCnt - 1) = RowNum
RowCnt = 8 'output row

For Cnt = LBound(Arr) To UBound(Arr) - 1
ColCnt = LetCnt + 5 ' Column "E"

If .Range(OutCol & Arr(Cnt)) = vbNullString Then
.Range(OutCol & Arr(Cnt)) = LetterArr(LetCnt)
.Cells(RowCnt, ColCnt) = CDbl(.Range(InCol & Arr(Cnt)))
Else
.Range(OutCol & Arr(Cnt)) = .Range(OutCol & Arr(Cnt)) & "," & LetterArr(LetCnt)
.Cells(RowCnt, ColCnt) = CDbl(.Range(InCol & Arr(Cnt)))
End If

RowCnt = RowCnt + 1
Next Cnt

LetCnt = LetCnt + 1
End If

If TotNum < InRng.Value Then
ArCnt = ArCnt + 1
ReDim Preserve Arr(ArCnt)
Arr(ArCnt - 1) = RowNum

Else
ArCnt = 0
ReDim Arr(0)
TotNum = 0
End If

GoTo above

Else
GoTo above
End If

End With


End Function




Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("E8:z208").ClearContents
End Sub

austenr
04-03-2020, 01:55 PM
High Paul

I assume that you changed the code I posted with the workbook. Im getting an error on the following do until line.:


rivate Sub Button1_Click() Dim LastRow As Long, Cnt As Long


Cnt = 1

With Sheets("Sheet1")

Do Until CheckCheques2("A", "B", .Range("C2").Value) Or Cnt = 200 *********************object required.
Cnt = Cnt + 1
Loop


If Cnt < 200 Then
MsgBox "DONE. Iterations: " & Cnt

'clear input
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'????? .Range("A2:A" & LastRow).Clear


Else
MsgBox "NO MATCH"
End If

End With


End Sub




The removal of the entries in Col A is I guess easier to see for the user. I guess that could be commented out. As for the randomization I actually didnt write the macro a person named Dave on here wrote it as I didnt have a clue how to make it work.

If there is a simpler way to do what Im trying to do then Im all for that. Originally I just wanted a way to enter the total and find the separate entries in Col A that make up the total. I really dont need the X,Y,Z columns but a listing of the entries that make up the total would be nice.

What is not clear to me is why pasting a csv column of numbers and trying to match the total entered is such a pain. I thought that there might be a way to paste the csv data some way to make it work. I tried every paste special I could find and it wont work. As stated previously typing in the numbers by hand makes it work. I know doing that doesnt involve spaces or special characters in the cells.

The purpose of this is that in Accounting they get checks with no remittance so they need a way to see if they can match the total of the check to outstanding invoices.

Paul_Hossler
04-03-2020, 02:42 PM
1. Remove the .Value



Do Until CheckCheques2("A", "B", .Range("C2")) Or Cnt = 200

2. I'm guessing that the random number was a way to guess at which invoices might give you the desired total, with an iteration cap of 200

After 200 guesses it throws a NO MATCH message

It's not really a VBA or data issue, but just a termination message after 200 guesses

3. A brute force approach won't really work since

a. your sample has 45 invoice amounts
b. each invoice can be 'In' or 'Out' = 3.5 x 10^13 possible combinations
c. you might have the entire amount on 1 invoice or on the total of 20 or really worst case you need all invoices


4. I suppose you could try

a. getting the total with 1 invoice (45 tries)
b. If that fails try 2 invoices (1980 tries)
c. If that fails try 3 invoices (85,140 tries)
d. If that fails try 4 invoices (35,75,880 tries)
e. etc.

8 invoices would be 8,691,104,822,400 tries

austenr
04-03-2020, 03:00 PM
So it isnt the pasting of the csv data its the fact that it cant find a match after 200 tries it says no match? there could potentially be over 200 invoices. i suppose that is why the randomization comes in. all along i thought it was the csv pasting.

Paul_Hossler
04-03-2020, 04:11 PM
That's a guess. It would explain why all of your fixes didn't work

Going by these statements



If Cnt < 200 Then
MsgBox "DONE. Iterations: " & Cnt

Else
MsgBox "NO MATCH"
End If


Let me think on it for a bit

Paul_Hossler
04-03-2020, 04:50 PM
This is sort of brute force, and I only made it so that it'd check up to 4 invoices to see it they matched the total

Easily expanded



Option Explicit


Dim A As Variant
Dim rInvoices As Range




Sub MatchInvoices()
Dim dTotal As Double
Dim N As Long

Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long

'init
dTotal = Range("D2")
Set rInvoices = Range("A1").CurrentRegion
A = Application.WorksheetFunction.Transpose(rInvoices.Value)
N = UBound(A)


'clear old colors
rInvoices.Interior.ColorIndex = xlColorIndexNone



'1 --------------------------------------------------------------------
For i1 = 2 To N
If pvtSum(i1) = dTotal Then
Call pvtFill(i1)
MsgBox "Done with 1 invoice"
GoTo NiceExit
End If
Next i1

'2 --------------------------------------------------------------------
For i1 = 2 To N - 1
For i2 = i1 + 1 To N
If pvtSum(i1, i2) = dTotal Then
Call pvtFill(i1, i2)
MsgBox "Done with 2 invoices"
GoTo NiceExit
End If
Next i2
Next i1

'3 --------------------------------------------------------------------
For i1 = 2 To N - 2
For i2 = i1 + 1 To N - 1
For i3 = i2 + 2 To N
If pvtSum(i1, i2, i3) = dTotal Then
Call pvtFill(i1, i2, i3)
MsgBox "Done with 3 invoices"
GoTo NiceExit
End If
Next i3
Next i2
Next i1


'4 --------------------------------------------------------------------
For i1 = 2 To N - 3
For i2 = i1 + 1 To N - 2
For i3 = i2 + 1 To N - 1
For i4 = i3 + 1 To N
If pvtSum(i1, i2, i3, i4) = dTotal Then
Call pvtFill(i1, i2, i3, i4)
MsgBox "Done with 4 invoices"
GoTo NiceExit
End If
Next i4
Next i3
Next i2
Next i1


NiceExit:


End Sub




Private Function pvtSum(ParamArray I())
Dim j As Long
Dim T As Double

T = 0#
For j = LBound(I) To UBound(I)
T = T + A(I(j))
Next j

pvtSum = T

End Function


Private Sub pvtFill(ParamArray I())
Dim j As Long

For j = LBound(I) To UBound(I)
rInvoices.Cells(I(j), 1).Interior.Color = vbGreen
Next j
End Sub

austenr
04-06-2020, 11:13 AM
Hi Paul,

this sounds crazy but i think i got it to work. I formatted the column A cells and the total you are looking for cells to currency. then I commented out the part where it throws a message box. ran it and got the desired results. I'd like to keep testing it but in the end the user wont want to keep past specialing it to currency. Is there a way to format col A cells to currency and even if someone just does a paste have the cells retain the currency formatting?

Paul_Hossler
04-06-2020, 11:22 AM
Don't see how just formatting as currency and commenting out the message bog would work

At the beginning of the macro, inside the With, add something like




.Columns(1).Style = "Currency"
.Range ("C1").Style = "Currency"

austenr
04-06-2020, 11:49 AM
thanks for the formatting tip. i know it shouldnt have any effect but switching it to anything else it wont work. ill let you know if i encounter any other weird stuff. im going to keep testing so ill leave the thread open for now.