MACRO w/Calculation -- HELP!!

T

tygrl510

Board Regular
Joined
Feb 9, 2009
Messages
54
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:
FOREX Table for EBA.xls
ABCDEFGHIJKLMNOP
1FY/FPUSDSGDJPYEURCHFGBPAUDNZDRMRMBINRIDRTWDBHTCAD
22010-011.000001.5202297.266800.757121.148500.703531.463061.773993.645646.8259451.7598311,547.3441133.9789335.223671.24891
32009-121.000001.5441697.751710.787711.168090.701211.554731.981383.698226.8306050.9943912,077.2946934.9406036.049031.25960
42009-111.000001.5085289.661970.776821.156740.698961.554971.959253.603606.8306049.0918011,441.6476033.7040834.638031.23016
52009-101.000001.4419690.358720.709371.055630.690661.447811.726823.477056.8166349.2126011,049.7237632.7868934.317091.22205
62009-091.000001.5126395.483620.787591.212860.650321.525551.819173.602316.8166349.6277912,755.1020433.2778735.21127
72009-081.000001.4718998.193240.765991.131610.606801.475361.691763.522376.8259450.6585610,638.29787
82009-071.000001.43021105.864920.692091.096730.550211.217881.468433.435256.8352747.258989,487.66603
92009-061.000001.41543108.766590.681251.100960.549001.164821.426333.380666.8259443.936739,165.90284
102009-051.000001.36799108.038030.641721.046570.504921.055301.359063.259456.8212842.444829,115.77028
112009-041.000001.36240106.067030.632951.018020.501151.040041.313373.254156.8540142.84490
122009-031.000001.36426105.462980.644081.046790.506021.046571.277793.238346.9348142.51701
132009-021.000001.36054104.036620.640661.035520.504541.069401.283203.152596.9735040.37142
142009-011.000001.3802699.186670.632910.994530.501231.089561.253603.188787.0028039.93610
152008-121.000001.39528106.168380.661071.060220.503911.060331.226993.200007.1022739.84064
162008-111.000001.42005106.963310.676411.092060.502511.000301.283703.232067.1839139.38558
172008-101.000001.44571112.246040.678931.125620.500681.140641.289993.312367.2939539.43218
182008-091.000001.44655109.962610.676091.114830.482981.131611.295843.369277.3692039.74563
192008-081.000001.45138114.652600.693911.163870.484591.087431.302253.342257.4626939.44773
202008-071.000001.48478114.810560.700671.163330.488351.125621.318743.403687.4962539.79308
212008-061.000001.52369115.727350.732871.202360.496621.223391.422073.506317.55858
222008-051.000001.51446118.497450.732231.204960.494001.174671.312163.450667.55858
232008-041.000001.53163123.304560.742121.228500.499031.178131.296683.455437.60456
242008-031.000001.52929121.565770.744161.225190.505481.220111.372873.400207.63359
252008-021.000001.51515119.574320.732171.205110.500431.204091.346983.417637.71010
262008-011.000001.51699117.910620.749911.217430.509551.237621.400363.455437.72201
272007-121.000001.62311116.265550.843311.319260.574151.353911.515843.702338.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
ABCD
2USDUSD1.00000
3USDSGD1.52022
4USDJPY97.26680
5USDEUR0.75712
6USDCHF1.14850
7USDGBP0.70353
8USDAUD1.46306
9USDNZD1.77399
10USDRM3.64564
11USDRMB6.82594
12USDINR51.75983
13USDIDR11,547.34411
14USDTWD33.97893
15USDBHT35.22367
16USDCAD1.24891
17SGDUSD0.64760
18SGDSGD1.00000
19SGDJPY63.30401
20SGDEUR0.51012
21SGDCHF0.75645
22SGDGBP0.45411
23SGDAUD1.00684
24SGDNZD1.28314
25SGDRM2.39497
26SGDRMB4.42350
27SGDINR33.02397
28SGDIDR7,821.25604
29SGDTWD22.62753
30SGDBHT23.34535
31SGDCAD0.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!!

:)</pre>
 
Sort by date Sort by votes
Try this (which includes a column for the period):

Code: 
Sub Test()
    Dim ShSource As Worksheet
    Dim Rng As Range
    Dim ShTarget As Worksheet
    Dim NextRow As Long
    Dim r As Long
    Dim c1 As Integer
    Dim c2 As Integer
    Set ShSource = Worksheets("Sheet1")
    Set Rng = ShSource.Range("A1").CurrentRegion
    Set ShTarget = Worksheets.Add
    With ShTarget
        .Range("A1").Value = "Date"
        .Range("B1").Value = "Curr1"
        .Range("C1").Value = "Curr2"
        .Range("D1").Value = "Rate"
    End With
    NextRow = 2
    With Rng
        For r = 2 To .Rows.Count
            For c1 = 2 To .Columns.Count
                ShTarget.Cells(NextRow, 1).Resize(.Columns.Count - 1).Value = .Cells(r, 1).Value
                For c2 = 2 To .Columns.Count
                    ShTarget.Cells(NextRow, 2).Value = .Cells(1, c1).Value
                    ShTarget.Cells(NextRow, 3).Value = .Cells(1, c2).Value
                    If .Cells(r, c1) <> "" Then
                        ShTarget.Cells(NextRow, 4).Value = .Cells(r, c2).Value / .Cells(r, c1).Value
                    End If
                    NextRow = NextRow + 1
                Next c2
            Next c1
        Next r
    End With
    ShTarget.Cells.EntireColumn.AutoFit
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
963
smozgur
smozgur
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
1K
GarnesGambit
G
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
3K
Attrazion
A
L
  • Question Question
Help with VBA code
Replies
0
Views
517
LordSnow548
L
J
  • Question Question
Send bulk email attachment error
Replies
3
Views
307
JOHATUP
J

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