Problem with code used in other countries

W

winnie123

Hi I created a file which basically acts as a price builder.

This has now been distrubted through out our European offices and the USA.

One of the modules alllows the user to select a couple of categories and
then you hit a button and it will create a new workbook with the relevant
pricing information.

It seems that the code reports an error and I am wondering if its due to the
fact that the information is pasted to the new workbook on Sheet1. Obvisously
sheet1 will be Tabelle1 for Germany and I think its Hoja1 for Spain.

How can I change the macro below to check for the language and then use the
appropirate name for the sheet.

I have seen an example below

Country_Code = Application.International(xlCountryCode)
If Country_Code = 49 Then


For each instance of Sheet1 use Tabelle1

My offending code is below

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub CopySelectedColumns()
Dim wbA As Workbook
Dim CopyToWb As Workbook
Dim RateCell As Range
Dim Cur As Range

Dim myRng As Range
Dim myCopy As String
Dim Wks As Worksheet

Set Wks = Worksheets("PriceLists")

myCopy = "P2,Q2"
With Wks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in Customer Level and Currency!"
Exit Sub
End If
End With


Set wbA = ThisWorkbook
SelectedCol = Range("P2").Value
fCol = Range("B1:N1").Find(what:=SelectedCol, _
Lookat:=xlWhole).Column


Set CopyToWb = Workbooks.Add
'("\\Mcuk-adc\Sales\Prices\PriceTemp.xlt")
Set RateCell = wbA.Worksheets("PriceLists").Range("R2")
Set Cur = wbA.Worksheets("PriceLists").Range("Q2")

wbA.Worksheets("PriceLists").Columns(1).Copy _
CopyToWb.Worksheets("Sheet1").Range("A1")
wbA.Worksheets("PriceLists").Columns(fCol).Copy _
CopyToWb.Worksheets("Sheet1").Range("B1")
CopyToWb.Worksheets("Sheet1").Range("A2") = _
fOSUserName & ", " & Now()


'Do
Customer = InputBox("Enter customer name", "Regards, EW")
'Loop Until Customer <> ""
If Customer = False Then
MsgBox "Ok, try later"
ActiveWindow.Close savechanges:=False

End If

If Customer = True Then
Else
CopyToWb.Worksheets("Sheet1").Range("A1") = Customer

LastRow = CopyToWb.Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

Cur.Copy
CopyToWb.Worksheets("Sheet1").Range("B2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

RateCell.Copy
CopyToWb.Worksheets("Sheet1").Range("B2:B" & LastRow).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False

If Range("B2").Text = "EUR" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$€-1809]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "USD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$$-409]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "AUD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$AUD] #,##0.00"
Range("A1").Select
End If



Application.Run "'Price Quote3.xls'! delete_zero"

'Application.Dialogs(xlDialogFormatNumber).Show

Range("B1").Select
Selection.ClearContents


'Do
SaveAsFilename = Application.GetSaveAsFilename _
(fileFilter:="Excel Files (*.xls), *.xls")
'Loop Until SaveAsFilename <> False

If SaveAsFilename = False Then
MsgBox "Ok, try later" 'user hit cancel
ActiveWindow.Close savechanges:=False
Exit Sub
End If



CopyToWb.SaveAs Filename:=SaveAsFilename
End If

CopyToWb.Close 'Remove this line if the new workbook shall remain open
'End If
'End If
End Sub

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function



Please can you advise/help me.

Thank you

Winnie
 
J

joel

I looks like you are adding a template that has only one sheet calle
"Sheet1". I would refere to the sheet by the position in the workboo
being the 1st tab and use sheets(1) instead of Sheets("Sheet1")
 
G

GB

Although it appears that you are attempting to make your code robust enough
to account for all of the potential identifications that Microsoft has made
for the first created sheet (in English "Sheet1") I would recommend that you
take control of the program and create your own new "sheet1" and call it
whatever you like. This way if you write any form of instruction to use your
program you can be assured that the sheet you are referring to in your
instruction exists as you describe it.

Basically this would be accomplished by creating a new worksheet and
capturing the created worksheet as a variable, then reidentifying the name of
the newly created sheet to the name you want. Of course you may want to
verify that the named sheet exists already. (Yet another factor you could
simply adapt/adopt in your code).

If Sheet1 doesn't exist, create a new worksheet and call it Sheet1.

A number of ways to go about it, but personally, I wouldn't go through the
trouble of identifying the potentially unknown number of languages that
Microsoft has used to call Sheet1 especially if they expand to adopt a new
language and you have to then modify your code to identify it.

If you do decide to use various international languages, then I can think of
a couple of ways to address returning the language and using it the way you
are wanting. I would use a function that returns the sheet name of the
language and then depending on the work level of the program, either
substitute each use of "Sheet1" with a reference to the function, or use a
variable in every function/sub that is set to the value of that function. I
deter using a global value that is expected to remain memory resident for the
entirety of the programs use, as I have come across too many instances where
that value is "forgotten" and the entire code crashes. (Sometimes "lost" as a
result of debugging an error in the code.)

My two cents worth if any help.

winnie123 said:
Hi I created a file which basically acts as a price builder.

This has now been distrubted through out our European offices and the USA.

One of the modules alllows the user to select a couple of categories and
then you hit a button and it will create a new workbook with the relevant
pricing information.

It seems that the code reports an error and I am wondering if its due to the
fact that the information is pasted to the new workbook on Sheet1. Obvisously
sheet1 will be Tabelle1 for Germany and I think its Hoja1 for Spain.

How can I change the macro below to check for the language and then use the
appropirate name for the sheet.

I have seen an example below

Country_Code = Application.International(xlCountryCode)
If Country_Code = 49 Then


For each instance of Sheet1 use Tabelle1

My offending code is below

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub CopySelectedColumns()
Dim wbA As Workbook
Dim CopyToWb As Workbook
Dim RateCell As Range
Dim Cur As Range

Dim myRng As Range
Dim myCopy As String
Dim Wks As Worksheet

Set Wks = Worksheets("PriceLists")

myCopy = "P2,Q2"
With Wks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in Customer Level and Currency!"
Exit Sub
End If
End With


Set wbA = ThisWorkbook
SelectedCol = Range("P2").Value
fCol = Range("B1:N1").Find(what:=SelectedCol, _
Lookat:=xlWhole).Column


Set CopyToWb = Workbooks.Add
'("\\Mcuk-adc\Sales\Prices\PriceTemp.xlt")
Set RateCell = wbA.Worksheets("PriceLists").Range("R2")
Set Cur = wbA.Worksheets("PriceLists").Range("Q2")

wbA.Worksheets("PriceLists").Columns(1).Copy _
CopyToWb.Worksheets("Sheet1").Range("A1")
wbA.Worksheets("PriceLists").Columns(fCol).Copy _
CopyToWb.Worksheets("Sheet1").Range("B1")
CopyToWb.Worksheets("Sheet1").Range("A2") = _
fOSUserName & ", " & Now()


'Do
Customer = InputBox("Enter customer name", "Regards, EW")
'Loop Until Customer <> ""
If Customer = False Then
MsgBox "Ok, try later"
ActiveWindow.Close savechanges:=False

End If

If Customer = True Then
Else
CopyToWb.Worksheets("Sheet1").Range("A1") = Customer

LastRow = CopyToWb.Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

Cur.Copy
CopyToWb.Worksheets("Sheet1").Range("B2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

RateCell.Copy
CopyToWb.Worksheets("Sheet1").Range("B2:B" & LastRow).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False

If Range("B2").Text = "EUR" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$€-1809]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "USD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$$-409]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "AUD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$AUD] #,##0.00"
Range("A1").Select
End If



Application.Run "'Price Quote3.xls'! delete_zero"

'Application.Dialogs(xlDialogFormatNumber).Show

Range("B1").Select
Selection.ClearContents


'Do
SaveAsFilename = Application.GetSaveAsFilename _
(fileFilter:="Excel Files (*.xls), *.xls")
'Loop Until SaveAsFilename <> False

If SaveAsFilename = False Then
MsgBox "Ok, try later" 'user hit cancel
ActiveWindow.Close savechanges:=False
Exit Sub
End If



CopyToWb.SaveAs Filename:=SaveAsFilename
End If

CopyToWb.Close 'Remove this line if the new workbook shall remain open
'End If
'End If
End Sub

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function



Please can you advise/help me.

Thank you

Winnie
Click to expand...
 
W

winnie123

Hi,

So when I add a new workbook I could also add a worksheet named "Prices"
and paste to the "Prices" sheet instead of Sheet1?

Would that work??

Many thanks
Winnie


GB said:
Although it appears that you are attempting to make your code robust enough
to account for all of the potential identifications that Microsoft has made
for the first created sheet (in English "Sheet1") I would recommend that you
take control of the program and create your own new "sheet1" and call it
whatever you like. This way if you write any form of instruction to use your
program you can be assured that the sheet you are referring to in your
instruction exists as you describe it.

Basically this would be accomplished by creating a new worksheet and
capturing the created worksheet as a variable, then reidentifying the name of
the newly created sheet to the name you want. Of course you may want to
verify that the named sheet exists already. (Yet another factor you could
simply adapt/adopt in your code).

If Sheet1 doesn't exist, create a new worksheet and call it Sheet1.

A number of ways to go about it, but personally, I wouldn't go through the
trouble of identifying the potentially unknown number of languages that
Microsoft has used to call Sheet1 especially if they expand to adopt a new
language and you have to then modify your code to identify it.

If you do decide to use various international languages, then I can think of
a couple of ways to address returning the language and using it the way you
are wanting. I would use a function that returns the sheet name of the
language and then depending on the work level of the program, either
substitute each use of "Sheet1" with a reference to the function, or use a
variable in every function/sub that is set to the value of that function. I
deter using a global value that is expected to remain memory resident for the
entirety of the programs use, as I have come across too many instances where
that value is "forgotten" and the entire code crashes. (Sometimes "lost" as a
result of debugging an error in the code.)

My two cents worth if any help.

winnie123 said:
Hi I created a file which basically acts as a price builder.

This has now been distrubted through out our European offices and the USA.

One of the modules alllows the user to select a couple of categories and
then you hit a button and it will create a new workbook with the relevant
pricing information.

It seems that the code reports an error and I am wondering if its due to the
fact that the information is pasted to the new workbook on Sheet1. Obvisously
sheet1 will be Tabelle1 for Germany and I think its Hoja1 for Spain.

How can I change the macro below to check for the language and then use the
appropirate name for the sheet.

I have seen an example below

Country_Code = Application.International(xlCountryCode)
If Country_Code = 49 Then


For each instance of Sheet1 use Tabelle1

My offending code is below

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub CopySelectedColumns()
Dim wbA As Workbook
Dim CopyToWb As Workbook
Dim RateCell As Range
Dim Cur As Range

Dim myRng As Range
Dim myCopy As String
Dim Wks As Worksheet

Set Wks = Worksheets("PriceLists")

myCopy = "P2,Q2"
With Wks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in Customer Level and Currency!"
Exit Sub
End If
End With


Set wbA = ThisWorkbook
SelectedCol = Range("P2").Value
fCol = Range("B1:N1").Find(what:=SelectedCol, _
Lookat:=xlWhole).Column


Set CopyToWb = Workbooks.Add
'("\\Mcuk-adc\Sales\Prices\PriceTemp.xlt")
Set RateCell = wbA.Worksheets("PriceLists").Range("R2")
Set Cur = wbA.Worksheets("PriceLists").Range("Q2")

wbA.Worksheets("PriceLists").Columns(1).Copy _
CopyToWb.Worksheets("Sheet1").Range("A1")
wbA.Worksheets("PriceLists").Columns(fCol).Copy _
CopyToWb.Worksheets("Sheet1").Range("B1")
CopyToWb.Worksheets("Sheet1").Range("A2") = _
fOSUserName & ", " & Now()


'Do
Customer = InputBox("Enter customer name", "Regards, EW")
'Loop Until Customer <> ""
If Customer = False Then
MsgBox "Ok, try later"
ActiveWindow.Close savechanges:=False

End If

If Customer = True Then
Else
CopyToWb.Worksheets("Sheet1").Range("A1") = Customer

LastRow = CopyToWb.Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

Cur.Copy
CopyToWb.Worksheets("Sheet1").Range("B2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

RateCell.Copy
CopyToWb.Worksheets("Sheet1").Range("B2:B" & LastRow).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False

If Range("B2").Text = "EUR" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$€-1809]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "USD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$$-409]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "AUD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$AUD] #,##0.00"
Range("A1").Select
End If



Application.Run "'Price Quote3.xls'! delete_zero"

'Application.Dialogs(xlDialogFormatNumber).Show

Range("B1").Select
Selection.ClearContents


'Do
SaveAsFilename = Application.GetSaveAsFilename _
(fileFilter:="Excel Files (*.xls), *.xls")
'Loop Until SaveAsFilename <> False

If SaveAsFilename = False Then
MsgBox "Ok, try later" 'user hit cancel
ActiveWindow.Close savechanges:=False
Exit Sub
End If



CopyToWb.SaveAs Filename:=SaveAsFilename
End If

CopyToWb.Close 'Remove this line if the new workbook shall remain open
'End If
'End If
End Sub

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function



Please can you advise/help me.

Thank you

Winnie
Click to expand...
Click to expand...
 
G

GB

Yup. Simple as that.

Certainly there may still be other worksheets in the workbook, and whether
you keep them or delete them is up to you. There is no hard standard as to
how many "other" sheets will be there. I think the default is 3; however,
that can be changed for each user by the user/administrator.

Create workbook
Create worksheet
change name of new worksheet to "Prices"
Use "Prices" in place of "Sheet1" in your code.

Then somehow tell the "world" what "Prices" means so that they can interpret
in their native language.

Sorry, haven't written the code to do it, but yes, it will work just like
that.

winnie123 said:
Hi,

So when I add a new workbook I could also add a worksheet named "Prices"
and paste to the "Prices" sheet instead of Sheet1?

Would that work??

Many thanks
Winnie


GB said:
Although it appears that you are attempting to make your code robust enough
to account for all of the potential identifications that Microsoft has made
for the first created sheet (in English "Sheet1") I would recommend that you
take control of the program and create your own new "sheet1" and call it
whatever you like. This way if you write any form of instruction to use your
program you can be assured that the sheet you are referring to in your
instruction exists as you describe it.

Basically this would be accomplished by creating a new worksheet and
capturing the created worksheet as a variable, then reidentifying the name of
the newly created sheet to the name you want. Of course you may want to
verify that the named sheet exists already. (Yet another factor you could
simply adapt/adopt in your code).

If Sheet1 doesn't exist, create a new worksheet and call it Sheet1.

A number of ways to go about it, but personally, I wouldn't go through the
trouble of identifying the potentially unknown number of languages that
Microsoft has used to call Sheet1 especially if they expand to adopt a new
language and you have to then modify your code to identify it.

If you do decide to use various international languages, then I can think of
a couple of ways to address returning the language and using it the way you
are wanting. I would use a function that returns the sheet name of the
language and then depending on the work level of the program, either
substitute each use of "Sheet1" with a reference to the function, or use a
variable in every function/sub that is set to the value of that function. I
deter using a global value that is expected to remain memory resident for the
entirety of the programs use, as I have come across too many instances where
that value is "forgotten" and the entire code crashes. (Sometimes "lost" as a
result of debugging an error in the code.)

My two cents worth if any help.

winnie123 said:
Hi I created a file which basically acts as a price builder.

This has now been distrubted through out our European offices and the USA.

One of the modules alllows the user to select a couple of categories and
then you hit a button and it will create a new workbook with the relevant
pricing information.

It seems that the code reports an error and I am wondering if its due to the
fact that the information is pasted to the new workbook on Sheet1. Obvisously
sheet1 will be Tabelle1 for Germany and I think its Hoja1 for Spain.

How can I change the macro below to check for the language and then use the
appropirate name for the sheet.

I have seen an example below

Country_Code = Application.International(xlCountryCode)
If Country_Code = 49 Then


For each instance of Sheet1 use Tabelle1

My offending code is below

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub CopySelectedColumns()
Dim wbA As Workbook
Dim CopyToWb As Workbook
Dim RateCell As Range
Dim Cur As Range

Dim myRng As Range
Dim myCopy As String
Dim Wks As Worksheet

Set Wks = Worksheets("PriceLists")

myCopy = "P2,Q2"
With Wks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in Customer Level and Currency!"
Exit Sub
End If
End With


Set wbA = ThisWorkbook
SelectedCol = Range("P2").Value
fCol = Range("B1:N1").Find(what:=SelectedCol, _
Lookat:=xlWhole).Column


Set CopyToWb = Workbooks.Add
'("\\Mcuk-adc\Sales\Prices\PriceTemp.xlt")
Set RateCell = wbA.Worksheets("PriceLists").Range("R2")
Set Cur = wbA.Worksheets("PriceLists").Range("Q2")

wbA.Worksheets("PriceLists").Columns(1).Copy _
CopyToWb.Worksheets("Sheet1").Range("A1")
wbA.Worksheets("PriceLists").Columns(fCol).Copy _
CopyToWb.Worksheets("Sheet1").Range("B1")
CopyToWb.Worksheets("Sheet1").Range("A2") = _
fOSUserName & ", " & Now()


'Do
Customer = InputBox("Enter customer name", "Regards, EW")
'Loop Until Customer <> ""
If Customer = False Then
MsgBox "Ok, try later"
ActiveWindow.Close savechanges:=False

End If

If Customer = True Then
Else
CopyToWb.Worksheets("Sheet1").Range("A1") = Customer

LastRow = CopyToWb.Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

Cur.Copy
CopyToWb.Worksheets("Sheet1").Range("B2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

RateCell.Copy
CopyToWb.Worksheets("Sheet1").Range("B2:B" & LastRow).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False

If Range("B2").Text = "EUR" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$€-1809]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "USD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$$-409]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "AUD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$AUD] #,##0.00"
Range("A1").Select
End If



Application.Run "'Price Quote3.xls'! delete_zero"

'Application.Dialogs(xlDialogFormatNumber).Show

Range("B1").Select
Selection.ClearContents


'Do
SaveAsFilename = Application.GetSaveAsFilename _
(fileFilter:="Excel Files (*.xls), *.xls")
'Loop Until SaveAsFilename <> False

If SaveAsFilename = False Then
MsgBox "Ok, try later" 'user hit cancel
ActiveWindow.Close savechanges:=False
Exit Sub
End If



CopyToWb.SaveAs Filename:=SaveAsFilename
End If

CopyToWb.Close 'Remove this line if the new workbook shall remain open
'End If
'End If
End Sub

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function



Please can you advise/help me.

Thank you

Winnie
Click to expand...
Click to expand...
Click to expand...
 
S

Sam Wilson

Hi,

Rather than referring to Worksheets("Sheet1") you can refer to Worksheets(0)
and that's universal.

Sam

winnie123 said:
Hi I created a file which basically acts as a price builder.

This has now been distrubted through out our European offices and the USA.

One of the modules alllows the user to select a couple of categories and
then you hit a button and it will create a new workbook with the relevant
pricing information.

It seems that the code reports an error and I am wondering if its due to the
fact that the information is pasted to the new workbook on Sheet1. Obvisously
sheet1 will be Tabelle1 for Germany and I think its Hoja1 for Spain.

How can I change the macro below to check for the language and then use the
appropirate name for the sheet.

I have seen an example below

Country_Code = Application.International(xlCountryCode)
If Country_Code = 49 Then


For each instance of Sheet1 use Tabelle1

My offending code is below

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub CopySelectedColumns()
Dim wbA As Workbook
Dim CopyToWb As Workbook
Dim RateCell As Range
Dim Cur As Range

Dim myRng As Range
Dim myCopy As String
Dim Wks As Worksheet

Set Wks = Worksheets("PriceLists")

myCopy = "P2,Q2"
With Wks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in Customer Level and Currency!"
Exit Sub
End If
End With


Set wbA = ThisWorkbook
SelectedCol = Range("P2").Value
fCol = Range("B1:N1").Find(what:=SelectedCol, _
Lookat:=xlWhole).Column


Set CopyToWb = Workbooks.Add
'("\\Mcuk-adc\Sales\Prices\PriceTemp.xlt")
Set RateCell = wbA.Worksheets("PriceLists").Range("R2")
Set Cur = wbA.Worksheets("PriceLists").Range("Q2")

wbA.Worksheets("PriceLists").Columns(1).Copy _
CopyToWb.Worksheets("Sheet1").Range("A1")
wbA.Worksheets("PriceLists").Columns(fCol).Copy _
CopyToWb.Worksheets("Sheet1").Range("B1")
CopyToWb.Worksheets("Sheet1").Range("A2") = _
fOSUserName & ", " & Now()


'Do
Customer = InputBox("Enter customer name", "Regards, EW")
'Loop Until Customer <> ""
If Customer = False Then
MsgBox "Ok, try later"
ActiveWindow.Close savechanges:=False

End If

If Customer = True Then
Else
CopyToWb.Worksheets("Sheet1").Range("A1") = Customer

LastRow = CopyToWb.Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

Cur.Copy
CopyToWb.Worksheets("Sheet1").Range("B2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

RateCell.Copy
CopyToWb.Worksheets("Sheet1").Range("B2:B" & LastRow).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False

If Range("B2").Text = "EUR" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$€-1809]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "USD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$$-409]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "AUD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$AUD] #,##0.00"
Range("A1").Select
End If



Application.Run "'Price Quote3.xls'! delete_zero"

'Application.Dialogs(xlDialogFormatNumber).Show

Range("B1").Select
Selection.ClearContents


'Do
SaveAsFilename = Application.GetSaveAsFilename _
(fileFilter:="Excel Files (*.xls), *.xls")
'Loop Until SaveAsFilename <> False

If SaveAsFilename = False Then
MsgBox "Ok, try later" 'user hit cancel
ActiveWindow.Close savechanges:=False
Exit Sub
End If



CopyToWb.SaveAs Filename:=SaveAsFilename
End If

CopyToWb.Close 'Remove this line if the new workbook shall remain open
'End If
'End If
End Sub

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function



Please can you advise/help me.

Thank you

Winnie
Click to expand...
 
W

winnie123

Yes as simple as that.

Many thanks

Just tried it on our German office and all is ok now.

Just need to resend my file out now to the rest of the world.

Best Regards
Winnie

GB said:
Yup. Simple as that.

Certainly there may still be other worksheets in the workbook, and whether
you keep them or delete them is up to you. There is no hard standard as to
how many "other" sheets will be there. I think the default is 3; however,
that can be changed for each user by the user/administrator.

Create workbook
Create worksheet
change name of new worksheet to "Prices"
Use "Prices" in place of "Sheet1" in your code.

Then somehow tell the "world" what "Prices" means so that they can interpret
in their native language.

Sorry, haven't written the code to do it, but yes, it will work just like
that.

winnie123 said:
Hi,

So when I add a new workbook I could also add a worksheet named "Prices"
and paste to the "Prices" sheet instead of Sheet1?

Would that work??

Many thanks
Winnie


GB said:
Although it appears that you are attempting to make your code robust enough
to account for all of the potential identifications that Microsoft has made
for the first created sheet (in English "Sheet1") I would recommend that you
take control of the program and create your own new "sheet1" and call it
whatever you like. This way if you write any form of instruction to use your
program you can be assured that the sheet you are referring to in your
instruction exists as you describe it.

Basically this would be accomplished by creating a new worksheet and
capturing the created worksheet as a variable, then reidentifying the name of
the newly created sheet to the name you want. Of course you may want to
verify that the named sheet exists already. (Yet another factor you could
simply adapt/adopt in your code).

If Sheet1 doesn't exist, create a new worksheet and call it Sheet1.

A number of ways to go about it, but personally, I wouldn't go through the
trouble of identifying the potentially unknown number of languages that
Microsoft has used to call Sheet1 especially if they expand to adopt a new
language and you have to then modify your code to identify it.

If you do decide to use various international languages, then I can think of
a couple of ways to address returning the language and using it the way you
are wanting. I would use a function that returns the sheet name of the
language and then depending on the work level of the program, either
substitute each use of "Sheet1" with a reference to the function, or use a
variable in every function/sub that is set to the value of that function. I
deter using a global value that is expected to remain memory resident for the
entirety of the programs use, as I have come across too many instances where
that value is "forgotten" and the entire code crashes. (Sometimes "lost" as a
result of debugging an error in the code.)

My two cents worth if any help.

:

Hi I created a file which basically acts as a price builder.

This has now been distrubted through out our European offices and the USA.

One of the modules alllows the user to select a couple of categories and
then you hit a button and it will create a new workbook with the relevant
pricing information.

It seems that the code reports an error and I am wondering if its due to the
fact that the information is pasted to the new workbook on Sheet1. Obvisously
sheet1 will be Tabelle1 for Germany and I think its Hoja1 for Spain.

How can I change the macro below to check for the language and then use the
appropirate name for the sheet.

I have seen an example below

Country_Code = Application.International(xlCountryCode)
If Country_Code = 49 Then


For each instance of Sheet1 use Tabelle1

My offending code is below

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub CopySelectedColumns()
Dim wbA As Workbook
Dim CopyToWb As Workbook
Dim RateCell As Range
Dim Cur As Range

Dim myRng As Range
Dim myCopy As String
Dim Wks As Worksheet

Set Wks = Worksheets("PriceLists")

myCopy = "P2,Q2"
With Wks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in Customer Level and Currency!"
Exit Sub
End If
End With


Set wbA = ThisWorkbook
SelectedCol = Range("P2").Value
fCol = Range("B1:N1").Find(what:=SelectedCol, _
Lookat:=xlWhole).Column


Set CopyToWb = Workbooks.Add
'("\\Mcuk-adc\Sales\Prices\PriceTemp.xlt")
Set RateCell = wbA.Worksheets("PriceLists").Range("R2")
Set Cur = wbA.Worksheets("PriceLists").Range("Q2")

wbA.Worksheets("PriceLists").Columns(1).Copy _
CopyToWb.Worksheets("Sheet1").Range("A1")
wbA.Worksheets("PriceLists").Columns(fCol).Copy _
CopyToWb.Worksheets("Sheet1").Range("B1")
CopyToWb.Worksheets("Sheet1").Range("A2") = _
fOSUserName & ", " & Now()


'Do
Customer = InputBox("Enter customer name", "Regards, EW")
'Loop Until Customer <> ""
If Customer = False Then
MsgBox "Ok, try later"
ActiveWindow.Close savechanges:=False

End If

If Customer = True Then
Else
CopyToWb.Worksheets("Sheet1").Range("A1") = Customer

LastRow = CopyToWb.Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

Cur.Copy
CopyToWb.Worksheets("Sheet1").Range("B2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

RateCell.Copy
CopyToWb.Worksheets("Sheet1").Range("B2:B" & LastRow).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False

If Range("B2").Text = "EUR" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$€-1809]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "USD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$$-409]#,##0.00"
Range("A1").Select
End If

If Range("B2").Text = "AUD" Then
Range("B4:B114").Select
Selection.NumberFormat = "[$AUD] #,##0.00"
Range("A1").Select
End If



Application.Run "'Price Quote3.xls'! delete_zero"

'Application.Dialogs(xlDialogFormatNumber).Show

Range("B1").Select
Selection.ClearContents


'Do
SaveAsFilename = Application.GetSaveAsFilename _
(fileFilter:="Excel Files (*.xls), *.xls")
'Loop Until SaveAsFilename <> False

If SaveAsFilename = False Then
MsgBox "Ok, try later" 'user hit cancel
ActiveWindow.Close savechanges:=False
Exit Sub
End If



CopyToWb.SaveAs Filename:=SaveAsFilename
End If

CopyToWb.Close 'Remove this line if the new workbook shall remain open
'End If
'End If
End Sub

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function



Please can you advise/help me.

Thank you

Winnie
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro to Select text from a point given to a specific word 2
Code does not error but no copy either 4
Similar Book to Book Code, one works other does not 11
Array code only works on selected sheet 14
VBA for Dependents shortcut menu 0
Development combinations with exclusion of columns 0
Development combinations with exclusion of columns 0
Code works but goes into endless loop and crashes 1

Top