Hi --
I currently have this FOREX table that I use to calculate the Local Currency to USD. But I need a macro that will calculate the other pairing. For example, I have the following table:
I need the macro to make the table into this format: Copy the first currency, and pair it with the others. Then copy the second currency and calculate the exchange rate. To calculate say the SGD to JPY is JPY/SGD, to calculate the IDR to SGD is IDR/SGD.
The macro should be able to count the number of columns, count the number of rows, transpose and calculate the other pairings. Does anyone know how to do this? I have a macro that someone on Mr. Excel provided me with that will move and copy the data:<meta http-equiv="Content-Type" content="text/html; charset=utf-8"><meta name="ProgId" content="Word.Document"><meta name="Generator" content="Microsoft Word 11"><meta name="Originator" content="Microsoft Word 11"><link rel="File-List" href="file:///C:%5CDOCUME%7E1%5Cr.ty%5CLOCALS%7E1%5CTemp%5Cmsohtml1%5C01%5Cclip_filelist.xml"><!--[if gte mso 9]><xml><w:WordDocument><w:View>Normal</w:View><w:Zoom>0</w:Zoom><w:PunctuationKerning/><w:ValidateAgainstSchemas/><w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid><w:IgnoreMixedContent>false</w:IgnoreMixedContent><w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText><w:Compatibility><w:BreakWrappedTables/><w:SnapToGridInCell/><w:WrapTextWithPunct/><w:UseAsianBreakRules/><w:DontGrowAutofit/></w:Compatibility><w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel></w:WordDocument></xml><![endif]--><!--[if gte mso 9]><xml><w:LatentStyles DefLockedState="false" LatentStyleCount="156"></w:LatentStyles></xml><![endif]--><style><!-- /* Font Definitions */ @font-face {font-family:Calibri; panose-1:2 15 5 2 2 2 4 3 2 4; mso-font-charset:0; mso-generic-font-family:swiss; mso-font-pitch:variable; mso-font-signature:-1610611985 1073750139 0 0 159 0;} /* Style Definitions */ p.MsoNormal, li.MsoNormal, div.MsoNormal {mso-style-parent:""; margin:0in; margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:12.0pt; font-family:Calibri; mso-fareast-font-family:"Times New Roman"; mso-bidi-font-family:"Times New Roman";} pre {margin:0in; margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Courier New"; mso-fareast-font-family:"Times New Roman";} @page Section1 {size:8.5in 11.0in; margin:1.0in 1.25in 1.0in 1.25in; mso-header-margin:.5in; mso-footer-margin:.5in; mso-paper-source:0;} div.Section1 {page:Section1;} --></style><!--[if gte mso 10]><style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;}</style><![endif]-->
Sub MoveData()</pre>
Dim LR As Long, LR2 As Long, LC As Long, Ctr As Long, NR As Long, ToMove As Long, RptLR As Long</pre>
Dim wks As Worksheet</pre>
Application.ScreenUpdating = False</pre>
Sheets(1).Select</pre>
On Error Resume Next</pre>
Sheets("Report").Select</pre>
If Err Then Worksheets.Add.Name = "Report"</pre>
On Error GoTo 0</pre>
With Sheets("Report")</pre>
.Range("A1").Resize(, 3).Value = [{"Category","Month","Amount"}]</pre>
RptLR = .Cells(Rows.Count, 1).End(xlUp).Row</pre>
If RptLR > 1 Then</pre>
.Range("A2:C" & RptLR).ClearContents</pre>
End If</pre>
End With</pre>
For Each wks In ThisWorkbook.Worksheets</pre>
If wks.Name<> "Instructions" And wks.Name<> "Report" Then</pre>
With wks</pre>
.Select</pre>
LC = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column</pre>
LR = .Cells(Rows.Count, 1).End(xlUp).Row</pre>
.Cells(1, LC + 2).Resize(, 3).Value = [{"Category","Month","Amount"}]</pre>
ToMove = LC - 1</pre>
For Ctr = 2 To LR Step 1</pre>
NR = .Cells(Rows.Count, LC + 2).End(xlUp).Row</pre>
.Range("A" & Ctr).Copy .Range(Cells(NR + 1, LC + 2), Cells(NR + ToMove, LC + 2))</pre>
.Range(Cells(1, 2), Cells(1, LC)).Copy</pre>
With .Cells(NR + 1, LC + 3)</pre>
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True</pre>
End With</pre>
.Range(Cells(Ctr, 2), Cells(Ctr, LC)).Copy</pre>
With .Cells(NR + 1, LC + 4)</pre>
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True</pre>
End With</pre>
Next Ctr</pre>
LR2 = .Cells(Rows.Count, LC + 2).End(xlUp).Row</pre>
RptLR = Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Row</pre>
.Range(Cells(2, LC + 2), Cells(LR2, LC + 4)).Copy Sheets("Report").Range("A" & RptLR + 1)</pre>
.Range(Cells(1, LC + 2), Cells(LR2, LC + 4)).ClearContents</pre>
.Range("A1").Select</pre>
Application.CutCopyMode = False</pre>
End With</pre>
End If</pre>
Next wks</pre>
Sheets("Report").Select</pre>
RptLR = Cells(Rows.Count, 1).End(xlUp).Row</pre>
Range("A1:C" & RptLR).Columns.AutoFit</pre>
Range("D1").Select</pre>
Application.ScreenUpdating = True</pre>
End Sub</pre>
If anyone knows how to modify this current macro to make the FOREX table listed above I would greatly appreciate it!!
Thanks in Advance!!
</pre>
I currently have this FOREX table that I use to calculate the Local Currency to USD. But I need a macro that will calculate the other pairing. For example, I have the following table:
FOREX Table for EBA.xls | ||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | |||
1 | FY/FP | USD | SGD | JPY | EUR | CHF | GBP | AUD | NZD | RM | RMB | INR | IDR | TWD | BHT | CAD | ||
2 | 2010-01 | 1.00000 | 1.52022 | 97.26680 | 0.75712 | 1.14850 | 0.70353 | 1.46306 | 1.77399 | 3.64564 | 6.82594 | 51.75983 | 11,547.34411 | 33.97893 | 35.22367 | 1.24891 | ||
3 | 2009-12 | 1.00000 | 1.54416 | 97.75171 | 0.78771 | 1.16809 | 0.70121 | 1.55473 | 1.98138 | 3.69822 | 6.83060 | 50.99439 | 12,077.29469 | 34.94060 | 36.04903 | 1.25960 | ||
4 | 2009-11 | 1.00000 | 1.50852 | 89.66197 | 0.77682 | 1.15674 | 0.69896 | 1.55497 | 1.95925 | 3.60360 | 6.83060 | 49.09180 | 11,441.64760 | 33.70408 | 34.63803 | 1.23016 | ||
5 | 2009-10 | 1.00000 | 1.44196 | 90.35872 | 0.70937 | 1.05563 | 0.69066 | 1.44781 | 1.72682 | 3.47705 | 6.81663 | 49.21260 | 11,049.72376 | 32.78689 | 34.31709 | 1.22205 | ||
6 | 2009-09 | 1.00000 | 1.51263 | 95.48362 | 0.78759 | 1.21286 | 0.65032 | 1.52555 | 1.81917 | 3.60231 | 6.81663 | 49.62779 | 12,755.10204 | 33.27787 | 35.21127 | |||
7 | 2009-08 | 1.00000 | 1.47189 | 98.19324 | 0.76599 | 1.13161 | 0.60680 | 1.47536 | 1.69176 | 3.52237 | 6.82594 | 50.65856 | 10,638.29787 | |||||
8 | 2009-07 | 1.00000 | 1.43021 | 105.86492 | 0.69209 | 1.09673 | 0.55021 | 1.21788 | 1.46843 | 3.43525 | 6.83527 | 47.25898 | 9,487.66603 | |||||
9 | 2009-06 | 1.00000 | 1.41543 | 108.76659 | 0.68125 | 1.10096 | 0.54900 | 1.16482 | 1.42633 | 3.38066 | 6.82594 | 43.93673 | 9,165.90284 | |||||
10 | 2009-05 | 1.00000 | 1.36799 | 108.03803 | 0.64172 | 1.04657 | 0.50492 | 1.05530 | 1.35906 | 3.25945 | 6.82128 | 42.44482 | 9,115.77028 | |||||
11 | 2009-04 | 1.00000 | 1.36240 | 106.06703 | 0.63295 | 1.01802 | 0.50115 | 1.04004 | 1.31337 | 3.25415 | 6.85401 | 42.84490 | ||||||
12 | 2009-03 | 1.00000 | 1.36426 | 105.46298 | 0.64408 | 1.04679 | 0.50602 | 1.04657 | 1.27779 | 3.23834 | 6.93481 | 42.51701 | ||||||
13 | 2009-02 | 1.00000 | 1.36054 | 104.03662 | 0.64066 | 1.03552 | 0.50454 | 1.06940 | 1.28320 | 3.15259 | 6.97350 | 40.37142 | ||||||
14 | 2009-01 | 1.00000 | 1.38026 | 99.18667 | 0.63291 | 0.99453 | 0.50123 | 1.08956 | 1.25360 | 3.18878 | 7.00280 | 39.93610 | ||||||
15 | 2008-12 | 1.00000 | 1.39528 | 106.16838 | 0.66107 | 1.06022 | 0.50391 | 1.06033 | 1.22699 | 3.20000 | 7.10227 | 39.84064 | ||||||
16 | 2008-11 | 1.00000 | 1.42005 | 106.96331 | 0.67641 | 1.09206 | 0.50251 | 1.00030 | 1.28370 | 3.23206 | 7.18391 | 39.38558 | ||||||
17 | 2008-10 | 1.00000 | 1.44571 | 112.24604 | 0.67893 | 1.12562 | 0.50068 | 1.14064 | 1.28999 | 3.31236 | 7.29395 | 39.43218 | ||||||
18 | 2008-09 | 1.00000 | 1.44655 | 109.96261 | 0.67609 | 1.11483 | 0.48298 | 1.13161 | 1.29584 | 3.36927 | 7.36920 | 39.74563 | ||||||
19 | 2008-08 | 1.00000 | 1.45138 | 114.65260 | 0.69391 | 1.16387 | 0.48459 | 1.08743 | 1.30225 | 3.34225 | 7.46269 | 39.44773 | ||||||
20 | 2008-07 | 1.00000 | 1.48478 | 114.81056 | 0.70067 | 1.16333 | 0.48835 | 1.12562 | 1.31874 | 3.40368 | 7.49625 | 39.79308 | ||||||
21 | 2008-06 | 1.00000 | 1.52369 | 115.72735 | 0.73287 | 1.20236 | 0.49662 | 1.22339 | 1.42207 | 3.50631 | 7.55858 | |||||||
22 | 2008-05 | 1.00000 | 1.51446 | 118.49745 | 0.73223 | 1.20496 | 0.49400 | 1.17467 | 1.31216 | 3.45066 | 7.55858 | |||||||
23 | 2008-04 | 1.00000 | 1.53163 | 123.30456 | 0.74212 | 1.22850 | 0.49903 | 1.17813 | 1.29668 | 3.45543 | 7.60456 | |||||||
24 | 2008-03 | 1.00000 | 1.52929 | 121.56577 | 0.74416 | 1.22519 | 0.50548 | 1.22011 | 1.37287 | 3.40020 | 7.63359 | |||||||
25 | 2008-02 | 1.00000 | 1.51515 | 119.57432 | 0.73217 | 1.20511 | 0.50043 | 1.20409 | 1.34698 | 3.41763 | 7.71010 | |||||||
26 | 2008-01 | 1.00000 | 1.51699 | 117.91062 | 0.74991 | 1.21743 | 0.50955 | 1.23762 | 1.40036 | 3.45543 | 7.72201 | |||||||
27 | 2007-12 | 1.00000 | 1.62311 | 116.26555 | 0.84331 | 1.31926 | 0.57415 | 1.35391 | 1.51584 | 3.70233 | 8.03859 | |||||||
Sheet1 |
I need the macro to make the table into this format: Copy the first currency, and pair it with the others. Then copy the second currency and calculate the exchange rate. To calculate say the SGD to JPY is JPY/SGD, to calculate the IDR to SGD is IDR/SGD.
FOREX Table for EBA.xls | ||||||
---|---|---|---|---|---|---|
A | B | C | D | |||
2 | USD | USD | 1.00000 | |||
3 | USD | SGD | 1.52022 | |||
4 | USD | JPY | 97.26680 | |||
5 | USD | EUR | 0.75712 | |||
6 | USD | CHF | 1.14850 | |||
7 | USD | GBP | 0.70353 | |||
8 | USD | AUD | 1.46306 | |||
9 | USD | NZD | 1.77399 | |||
10 | USD | RM | 3.64564 | |||
11 | USD | RMB | 6.82594 | |||
12 | USD | INR | 51.75983 | |||
13 | USD | IDR | 11,547.34411 | |||
14 | USD | TWD | 33.97893 | |||
15 | USD | BHT | 35.22367 | |||
16 | USD | CAD | 1.24891 | |||
17 | SGD | USD | 0.64760 | |||
18 | SGD | SGD | 1.00000 | |||
19 | SGD | JPY | 63.30401 | |||
20 | SGD | EUR | 0.51012 | |||
21 | SGD | CHF | 0.75645 | |||
22 | SGD | GBP | 0.45411 | |||
23 | SGD | AUD | 1.00684 | |||
24 | SGD | NZD | 1.28314 | |||
25 | SGD | RM | 2.39497 | |||
26 | SGD | RMB | 4.42350 | |||
27 | SGD | INR | 33.02397 | |||
28 | SGD | IDR | 7,821.25604 | |||
29 | SGD | TWD | 22.62753 | |||
30 | SGD | BHT | 23.34535 | |||
31 | SGD | CAD | 0.81572 | |||
Sheet2 |
The macro should be able to count the number of columns, count the number of rows, transpose and calculate the other pairings. Does anyone know how to do this? I have a macro that someone on Mr. Excel provided me with that will move and copy the data:<meta http-equiv="Content-Type" content="text/html; charset=utf-8"><meta name="ProgId" content="Word.Document"><meta name="Generator" content="Microsoft Word 11"><meta name="Originator" content="Microsoft Word 11"><link rel="File-List" href="file:///C:%5CDOCUME%7E1%5Cr.ty%5CLOCALS%7E1%5CTemp%5Cmsohtml1%5C01%5Cclip_filelist.xml"><!--[if gte mso 9]><xml><w:WordDocument><w:View>Normal</w:View><w:Zoom>0</w:Zoom><w:PunctuationKerning/><w:ValidateAgainstSchemas/><w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid><w:IgnoreMixedContent>false</w:IgnoreMixedContent><w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText><w:Compatibility><w:BreakWrappedTables/><w:SnapToGridInCell/><w:WrapTextWithPunct/><w:UseAsianBreakRules/><w:DontGrowAutofit/></w:Compatibility><w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel></w:WordDocument></xml><![endif]--><!--[if gte mso 9]><xml><w:LatentStyles DefLockedState="false" LatentStyleCount="156"></w:LatentStyles></xml><![endif]--><style><!-- /* Font Definitions */ @font-face {font-family:Calibri; panose-1:2 15 5 2 2 2 4 3 2 4; mso-font-charset:0; mso-generic-font-family:swiss; mso-font-pitch:variable; mso-font-signature:-1610611985 1073750139 0 0 159 0;} /* Style Definitions */ p.MsoNormal, li.MsoNormal, div.MsoNormal {mso-style-parent:""; margin:0in; margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:12.0pt; font-family:Calibri; mso-fareast-font-family:"Times New Roman"; mso-bidi-font-family:"Times New Roman";} pre {margin:0in; margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Courier New"; mso-fareast-font-family:"Times New Roman";} @page Section1 {size:8.5in 11.0in; margin:1.0in 1.25in 1.0in 1.25in; mso-header-margin:.5in; mso-footer-margin:.5in; mso-paper-source:0;} div.Section1 {page:Section1;} --></style><!--[if gte mso 10]><style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;}</style><![endif]-->
Sub MoveData()</pre>
Dim LR As Long, LR2 As Long, LC As Long, Ctr As Long, NR As Long, ToMove As Long, RptLR As Long</pre>
Dim wks As Worksheet</pre>
Application.ScreenUpdating = False</pre>
Sheets(1).Select</pre>
On Error Resume Next</pre>
Sheets("Report").Select</pre>
If Err Then Worksheets.Add.Name = "Report"</pre>
On Error GoTo 0</pre>
With Sheets("Report")</pre>
.Range("A1").Resize(, 3).Value = [{"Category","Month","Amount"}]</pre>
RptLR = .Cells(Rows.Count, 1).End(xlUp).Row</pre>
If RptLR > 1 Then</pre>
.Range("A2:C" & RptLR).ClearContents</pre>
End If</pre>
End With</pre>
For Each wks In ThisWorkbook.Worksheets</pre>
If wks.Name<> "Instructions" And wks.Name<> "Report" Then</pre>
With wks</pre>
.Select</pre>
LC = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column</pre>
LR = .Cells(Rows.Count, 1).End(xlUp).Row</pre>
.Cells(1, LC + 2).Resize(, 3).Value = [{"Category","Month","Amount"}]</pre>
ToMove = LC - 1</pre>
For Ctr = 2 To LR Step 1</pre>
NR = .Cells(Rows.Count, LC + 2).End(xlUp).Row</pre>
.Range("A" & Ctr).Copy .Range(Cells(NR + 1, LC + 2), Cells(NR + ToMove, LC + 2))</pre>
.Range(Cells(1, 2), Cells(1, LC)).Copy</pre>
With .Cells(NR + 1, LC + 3)</pre>
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True</pre>
End With</pre>
.Range(Cells(Ctr, 2), Cells(Ctr, LC)).Copy</pre>
With .Cells(NR + 1, LC + 4)</pre>
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True</pre>
End With</pre>
Next Ctr</pre>
LR2 = .Cells(Rows.Count, LC + 2).End(xlUp).Row</pre>
RptLR = Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Row</pre>
.Range(Cells(2, LC + 2), Cells(LR2, LC + 4)).Copy Sheets("Report").Range("A" & RptLR + 1)</pre>
.Range(Cells(1, LC + 2), Cells(LR2, LC + 4)).ClearContents</pre>
.Range("A1").Select</pre>
Application.CutCopyMode = False</pre>
End With</pre>
End If</pre>
Next wks</pre>
Sheets("Report").Select</pre>
RptLR = Cells(Rows.Count, 1).End(xlUp).Row</pre>
Range("A1:C" & RptLR).Columns.AutoFit</pre>
Range("D1").Select</pre>
Application.ScreenUpdating = True</pre>
End Sub</pre>
If anyone knows how to modify this current macro to make the FOREX table listed above I would greatly appreciate it!!
Thanks in Advance!!
