bdb91
08-02-2019, 07:13 AM
Hello experts,
Seeking for your help in fixing a macro which should extract amounts from text strings in thefirst column on the current sheet.
The format of amounts is like this: 15´068.20
Strings consist also other numeric signs which are not amounts, e.g. field numbers like 2.2 or zip codes like 3284 etc. In addition to it amounts are not always in the beginning of the string. There are two elements which can help to identify amounts: 1) a separator ´ and 2) a decimal piont with following two numbers in the end like .00
I wrote followingcode which should extract numbers:
Sub Test9()
Dim i As Long
Dim j As Long
Dim AmountValue As String
For i = 1 To Rows.Count
If InStr(Cells(i, 1).Value, ".") > 0 And IsNumeric(Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") + 1, 2)) = True And Not (Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") + 2, 1)) = " " Then
Do While IsNumeric(Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") - 1, 1)) = True Or Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") - 1, 1) = "´"
DoEvents
j = 0
AmountValue = Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") - 1, 4 + j)
j = j + 1
Loop
Cells(i, 5).Value = AmountValue
End If
Next i
End Sub
The problem withthis code is that when macro runs I will see NOT RESPONDING in top ofExcel VBA and Excel doesn't respond anymore. I added DoEvents into the code. It helps to avoid Excel freezing but the macro getting stuck anyways and doesn’t return any values.
Any suggestionshow to optimise the code that it works?
Thanks a lot inadvance!
Seeking for your help in fixing a macro which should extract amounts from text strings in thefirst column on the current sheet.
The format of amounts is like this: 15´068.20
Strings consist also other numeric signs which are not amounts, e.g. field numbers like 2.2 or zip codes like 3284 etc. In addition to it amounts are not always in the beginning of the string. There are two elements which can help to identify amounts: 1) a separator ´ and 2) a decimal piont with following two numbers in the end like .00
I wrote followingcode which should extract numbers:
Sub Test9()
Dim i As Long
Dim j As Long
Dim AmountValue As String
For i = 1 To Rows.Count
If InStr(Cells(i, 1).Value, ".") > 0 And IsNumeric(Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") + 1, 2)) = True And Not (Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") + 2, 1)) = " " Then
Do While IsNumeric(Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") - 1, 1)) = True Or Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") - 1, 1) = "´"
DoEvents
j = 0
AmountValue = Mid(Cells(i, 1), InStr(Cells(i, 1).Value, ".") - 1, 4 + j)
j = j + 1
Loop
Cells(i, 5).Value = AmountValue
End If
Next i
End Sub
The problem withthis code is that when macro runs I will see NOT RESPONDING in top ofExcel VBA and Excel doesn't respond anymore. I added DoEvents into the code. It helps to avoid Excel freezing but the macro getting stuck anyways and doesn’t return any values.
Any suggestionshow to optimise the code that it works?
Thanks a lot inadvance!