Windows Regional Setting Issue: Decimal & Thousand Separator for Excel VBA Macro

Z

Zem32619

New Member
Joined
Jul 2, 2021
Messages
29
Office Version
  1. 365
Platform
  1. Windows
Hi Excel Masters.

Good day. Here I am again doing a macro that should work on all regional setting (eg UK/Germany). My current macro works perfectly fine with the US setting. I've been searching for quite sometime now for workarounds to deal with this separator issue, but I haven't seen one that works for me atleast, or maybe just over complicated for me. Any help would really be appreciated. I'm stil a newbie here and don't know much yet about vba.
Below is the code that is working fine for US setting.
Thank you in advance.

VBA Code: 
Sub call_Products()
'

 Application.ScreenUpdating = False
    
'Dim bCurrent As Boolean

'bCurrent = Application.UseSystemSeparators
'If bCurrent Then
'With Application
'    .DecimalSeparator = ","
'    .ThousandsSeparator = "."
'    .UseSystemSeparators = False
'End With
'Else
'With Application
'    .DecimalSeparator = "."
'    .ThousandsSeparator = ","
'    .UseSystemSeparators = True
'End With
'End If


 Dim ACoS As Variant
 Dim lr As Integer
' Input statement


Num1 = (Application.InputBox(Prompt:="Enter Target number. ", Title:="Enter a number", Type:=1) / 100)


 If Num1 = False Then
 Exit Sub
 End If
 


 On Error Resume Next
 lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row 'Last row with data
    
    'With Application
    '   .DecimalSeparator = "."
    '   .ThousandsSeparator = ","
    '   .UseSystemSeparators = False
    'Columns("K:K").Replace What:=",", Replacement:="."
    'Columns("T:T").Replace What:=",", Replacement:="."
    'Columns("U:U").Replace What:=",", Replacement:="."
    'Columns("V:V").Replace What:=",", Replacement:="."
    'Columns("X:X").Replace What:=",", Replacement:="."
    'Columns("Y:Y").Replace What:=",", Replacement:="."
    'End With
    
    ActiveSheet.Range("$A$1:$AB$" & lr).AutoFilter Field:=2, Criteria1:="=Keyword"
    ActiveSheet.Range("$A$1:$AB$" & lr).AutoFilter Field:=4, Criteria1:="<>*auto*"
    Columns("K:K").TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Columns("Y:Y").TextToColumns Destination:=Range("Y1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    'ActiveSheet.Range("$A$1:$AB$" & lr).AutoFilter Field:=25, Criteria1:=">= " & Num1 '& ""
    ActiveSheet.Range("$A$1:$AB$" & lr).AutoFilter Field:=25, Criteria1:=">= " & Replace(Num1, ",", ".")
    
'Adding new sheets for Calib Pre and pasting data from main sheet
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Process 1"
    ActiveSheet.Paste
    
'Adding new sheets for Calib Post and pasting data from Calib Pre sheet
    Sheets("Process 1").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Process 2"
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("L:L").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
' Bid

    Range("L1").FormulaR1C1 = "Bid"
    Range("L2").FormulaR1C1 = "=(1-(RC[14]-& Num1&  ))*RC[-1]"
    Range("L2").Select
    lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    On Error Resume Next
    Selection.AutoFill Destination:=Range("L2:L" & lr)
    Range("L2:L" & lr).Select
    Columns("W:W").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
' CPC
    Range("W1").FormulaR1C1 = "CPC"
    Range("W2").FormulaR1C1 = "=RC[-1]/RC[-2]"
    Range("W2").Select
    lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    On Error Resume Next
    Selection.AutoFill Destination:=Range("W2:W" & lr)
    Range("W2:W" & lr).Select
    Columns("M:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
' Litmus Test
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Litmus Test"
    Range("M2").FormulaR1C1 = "=IF(RC[-2]>RC[11], ""Calibrate"", ""Leave"")"
    Range("M2").Select
    lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    On Error Resume Next
    Range("M2").AutoFill Destination:=Range("M2:M" & lr)
    Range("M2:M" & lr).Select
    
'Filter to Calibrate
    Range("M1").AutoFilter
    On Error Resume Next
    ActiveSheet.Range("$A$1:$AE$" & lr).AutoFilter Field:=13, Criteria1:="Calibrate"  ' ok
    
        
' Limit and Limit Test
    Sheets("Process 2").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Select
    ActiveSheet.Name = "Process 3"
    ActiveSheet.Paste
    Application.CutCopyMode = False
        
    
'Limit Calculation
    Sheets("Process 3").Select
    Columns("N:N").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("N1").FormulaR1C1 = "Limit"
    Range("N2").FormulaR1C1 = "=RC[11]*0.8"
    Range("N2").Select
    lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    On Error Resume Next
    Selection.AutoFill Destination:=Range("N2:N" & lr)
    
    If Range("N2") = 0 Then
    Range("N2").ClearContents
    Else
    End If
  
'Limit Test
    Range("N2:N" & lr).Select
    Columns("O:O").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("O1").FormulaR1C1 = "Limit Test"
    Range("O2").FormulaR1C1 = "=IF(RC[-3]>RC[-1],""Keep"",""Limit"")"
    lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    On Error Resume Next
    Range("O2").AutoFill Destination:=Range("O2:O" & lr)
    
    If Range("N2") = 0 Then
    Range("O2").ClearContents
    Else
    End If
    
    
' If Limit Test says "Limit" will copy the Limit bid as New Bid
    Range("O2:O" & lr).Select
    Cells.Select
    Dim ws As Worksheet
    Dim lngMyRow As Long
    Application.ScreenUpdating = False
    Set ws = Sheets("Calibration Post Limit")
    For lngMyRow = 2 To ws.Cells(Rows.Count, "O").End(xlUp).Row
        If StrConv(ws.Range("O" & lngMyRow), vbProperCase) = "Limit" Then
            ws.Range("L" & lngMyRow).Value = ws.Range("N" & lngMyRow).Value
        End If
    Next lngMyRow
    Application.ScreenUpdating = True
    
    
' Copy Calibration Post Limit sheet to a new workbook
    
    Sheets("Process 3").Copy
    ActiveSheet.Name = "Sheet1"
  
' Copy new bid to Max bid column

    Application.ScreenUpdating = False
    Range("K2:K" & lr).Value = Range("L2:L" & lr).Value
    Application.ScreenUpdating = True
 
'Delete all formulaic columns
  
    Columns("L:O").EntireColumn.Delete
    Columns("V:V").EntireColumn.Delete
    Range("A1").Select
    
      
    Application.UseSystemSeparators = True
    Application.ScreenUpdating = True
    
End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

Noid67
  • Question Question
Run-time 1004 for this With statement
Replies
2
Views
172
Peter_SSs
Peter_SSs
R
  • Solved
TextToColumns, VBA to uncheck "Treat consecutive delimiters as one"
Replies
5
Views
100
Joe4
Joe4
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
263
rlv01
R
C
  • Question Question
How to get my macro to stop at the last recognized line
Replies
6
Views
544
Coco1
C
N
  • Question Question
AutoFilter Field Macro Returns a Header Row only
2
Replies
11
Views
102
MARK858
MARK858

Forum statistics

Threads
1,223,888
Messages
6,175,217
Members
452,619
Latest member
Shiv1198

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top