Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help with macro
What I try to do with my file is e.g. if I write to cell (T41) 21a it
copies to (B17) 70a or if I write to (F161) to 6b it copies to (M5) 263a and so on ( I want that is if I write to some cell the value of 1a, 1b . . . 500a, 500b e.g. 12a to cell B23 it copies the cell B20 to D11 ) through the whole spreadsheet from B2 to U299 hopefully this will clarify what I'm trying to do so far I have been able to get it working with macros like below but I would need to make 1000 macros like that and now I have 10 macros ready and when I run them it takes approximately 1 min to complete the 10 macro so is there some other way to do this / smarter /faster there is link to mytempdir where you can look my spreadsheet http://www.mytempdir.com/978269 ------------------------------------------------------------------------------- Sub täyttö_1a() ' 1a '1-10 Dim i&, u&, y&: y = 0 For i = 2 To 21 u = 1 If i Mod 2 = 0 Then y = y + 1: u = 2 If Cells(5, i) = [B2] Then [b5].Value = y & Choose(u, "b", "a") Exit For End If Next i ' '11-20 Dim ii&, uu&, yy&: yy = 10 For ii = 2 To 21 uu = 1 If ii Mod 2 = 0 Then yy = yy + 1: uu = 2 If Cells(11, ii) = [B2] Then [b5].Value = yy & Choose(uu, "b", "a") Exit For End If Next ii ' '21-30 Dim iii&, uuu&, yyy&: yyy = 20 For iii = 2 To 21 uuu = 1 If iii Mod 2 = 0 Then yyy = yyy + 1: uuu = 2 If Cells(17, iii) = [B2] Then [b5].Value = yyy & Choose(uuu, "b", "a") Exit For End If Next iii ' '31-40 Dim iiii&, uuuu&, yyyy&: yyyy = 30 For iiii = 2 To 21 uuuu = 1 If iiii Mod 2 = 0 Then yyyy = yyyy + 1: uuuu = 2 If Cells(23, iiii) = [B2] Then [b5].Value = yyyy & Choose(uuuu, "b", "a") Exit For End If Next iiii ' '41-50 Dim iiiii&, uuuuu&, yyyyy&: yyyyy = 40 For iiiii = 2 To 21 uuuuu = 1 If iiiii Mod 2 = 0 Then yyyyy = yyyyy + 1: uuuuu = 2 If Cells(29, iiiii) = [B2] Then [b5].Value = yyyyy & Choose(uuuuu, "b", "a") Exit For End If Next iiiii ' '51-60 Dim iiiiii&, uuuuuu&, yyyyyy&: yyyyyy = 50 For iiiiii = 2 To 21 uuuuuu = 1 If iiiiii Mod 2 = 0 Then yyyyyy = yyyyyy + 1: uuuuuu = 2 If Cells(35, iiiiii) = [B2] Then [b5].Value = yyyyyy & Choose(uuuuuu, "b", "a") Exit For End If Next iiiiii ' '61-70 Dim iiiiiii&, uuuuuuu&, yyyyyyy&: yyyyyyy = 60 For iiiiiii = 2 To 21 uuuuuuu = 1 If iiiiiii Mod 2 = 0 Then yyyyyyy = yyyyyyy + 1: uuuuuuu = 2 If Cells(41, iiiiiii) = [B2] Then [b5].Value = yyyyyyy & Choose(uuuuuuu, "b", "a") Exit For End If Next iiiiiii ' '71-80 Dim iiiiiiii&, uuuuuuuu&, yyyyyyyy&: yyyyyyyy = 70 For iiiiiiii = 2 To 21 uuuuuuuu = 1 If iiiiiiii Mod 2 = 0 Then yyyyyyyy = yyyyyyyy + 1: uuuuuuuu = 2 If Cells(47, iiiiiiii) = [B2] Then [b5].Value = yyyyyyyy & Choose(uuuuuuuu, "b", "a") Exit For End If Next iiiiiiii ' '81-90 Dim iiiiiiiii&, uuuuuuuuu&, yyyyyyyyy&: yyyyyyyyy = 80 For iiiiiiiii = 2 To 21 uuuuuuuuu = 1 If iiiiiiiii Mod 2 = 0 Then yyyyyyyyy = yyyyyyyyy + 1: uuuuuuuuu = 2 If Cells(53, iiiiiiiii) = [B2] Then [b5].Value = yyyyyyyyy & Choose(uuuuuuuuu, "b", "a") Exit For End If Next iiiiiiiii ' '91-100 Dim iiiiiiiiii&, uuuuuuuuuu&, yyyyyyyyyy&: yyyyyyyyyy = 90 For iiiiiiiiii = 2 To 21 uuuuuuuuuu = 1 If iiiiiiiiii Mod 2 = 0 Then yyyyyyyyyy = yyyyyyyyyy + 1: uuuuuuuuuu = 2 If Cells(59, iiiiiiiiii) = [B2] Then [b5].Value = yyyyyyyyyy & Choose(uuuuuuuuuu, "b", "a") Exit For End If Next iiiiiiiiii ' '101-110 Dim ia&, ua&, ya&: ya = 100 For ia = 2 To 21 ua = 1 If ia Mod 2 = 0 Then ya = ya + 1: ua = 2 If Cells(65, ia) = [B2] Then [b5].Value = ya & Choose(ua, "b", "a") Exit For End If Next ia ' '111-120 Dim iaa&, uaa&, yaa&: yaa = 110 For iaa = 2 To 21 uaa = 1 If iaa Mod 2 = 0 Then yaa = yaa + 1: uaa = 2 If Cells(71, iaa) = [B2] Then [b5].Value = yaa & Choose(uaa, "b", "a") Exit For End If Next iaa ' '121-130 Dim iaaa&, uaaa&, yaaa&: yaaa = 120 For iaaa = 2 To 21 uaaa = 1 If iaaa Mod 2 = 0 Then yaaa = yaaa + 1: uaaa = 2 If Cells(77, iaaa) = [B2] Then [b5].Value = yaaa & Choose(uaaa, "b", "a") Exit For End If Next iaaa ' '131-140 Dim iaaaa&, uaaaa&, yaaaa&: yaaaa = 130 For iaaaa = 2 To 21 uaaaa = 1 If iaaaa Mod 2 = 0 Then yaaaa = yaaaa + 1: uaaaa = 2 If Cells(83, iaaaa) = [B2] Then [b5].Value = yaaaa & Choose(uaaaa, "b", "a") Exit For End If Next iaaaa ' '141-150 Dim iaaaaa&, uaaaaa&, yaaaaa&: yaaaaa = 140 For iaaaaa = 2 To 21 uaaaaa = 1 If iaaaaa Mod 2 = 0 Then yaaaaa = yaaaaa + 1: uaaaaa = 2 If Cells(89, iaaaaa) = [B2] Then [b5].Value = yaaaaa & Choose(uaaaaa, "b", "a") Exit For End If Next iaaaaa ' '151-160 Dim iaaaaaa&, uaaaaaa&, yaaaaaa&: yaaaaaa = 150 For iaaaaaa = 2 To 21 uaaaaaa = 1 If iaaaaaa Mod 2 = 0 Then yaaaaaa = yaaaaaa + 1: uaaaaaa = 2 If Cells(95, iaaaaaa) = [B2] Then [b5].Value = yaaaaaa & Choose(uaaaaaa, "b", "a") Exit For End If Next iaaaaaa ' '161-170 Dim iaaaaaaa&, uaaaaaaa&, yaaaaaaa&: yaaaaaaa = 160 For iaaaaaaa = 2 To 21 uaaaaaaa = 1 If iaaaaaaa Mod 2 = 0 Then yaaaaaaa = yaaaaaaa + 1: uaaaaaaa = 2 If Cells(101, iaaaaaaa) = [B2] Then [b5].Value = yaaaaaaa & Choose(uaaaaaaa, "b", "a") Exit For End If Next iaaaaaaa ' '171-180 Dim iaaaaaaaa&, uaaaaaaaa&, yaaaaaaaa&: yaaaaaaaa = 170 For iaaaaaaaa = 2 To 21 uaaaaaaaa = 1 If iaaaaaaaa Mod 2 = 0 Then yaaaaaaaa = yaaaaaaaa + 1: uaaaaaaaa = 2 If Cells(107, iaaaaaaaa) = [B2] Then [b5].Value = yaaaaaaaa & Choose(uaaaaaaaa, "b", "a") Exit For End If Next iaaaaaaaa ' '181-190 Dim iaaaaaaaaa&, uaaaaaaaaa&, yaaaaaaaaa&: yaaaaaaaaa = 180 For iaaaaaaaaa = 2 To 21 uaaaaaaaaa = 1 If iaaaaaaaaa Mod 2 = 0 Then yaaaaaaaaa = yaaaaaaaaa + 1: uaaaaaaaaa = 2 If Cells(113, iaaaaaaaaa) = [B2] Then [b5].Value = yaaaaaaaaa & Choose(uaaaaaaaaa, "b", "a") Exit For End If Next iaaaaaaaaa ' '191-200 Dim iaaaaaaaaaa&, uaaaaaaaaaa&, yaaaaaaaaaa&: yaaaaaaaaaa = 190 For iaaaaaaaaaa = 2 To 21 uaaaaaaaaaa = 1 If iaaaaaaaaaa Mod 2 = 0 Then yaaaaaaaaaa = yaaaaaaaaaa + 1: uaaaaaaaaaa = 2 If Cells(119, iaaaaaaaaaa) = [B2] Then [b5].Value = yaaaaaaaaaa & Choose(uaaaaaaaaaa, "b", "a") Exit For End If Next iaaaaaaaaaa ' '201-210 Dim ib&, ub&, yb&: yb = 200 For ib = 2 To 21 ub = 1 If ib Mod 2 = 0 Then yb = yb + 1: ub = 2 If Cells(125, ib) = [B2] Then [b5].Value = yb & Choose(ub, "b", "a") Exit For End If Next ib ' '211-220 Dim ibb&, ubb&, ybb&: ybb = 210 For ibb = 2 To 21 ubb = 1 If ibb Mod 2 = 0 Then ybb = ybb + 1: ubb = 2 If Cells(131, ibb) = [B2] Then [b5].Value = ybb & Choose(ubb, "b", "a") Exit For End If Next ibb ' '221-230 Dim ibbb&, ubbb&, ybbb&: ybbb = 220 For ibbb = 2 To 21 ubbb = 1 If ibbb Mod 2 = 0 Then ybbb = ybbb + 1: ubbb = 2 If Cells(137, ibbb) = [B2] Then [b5].Value = ybbb & Choose(ubbb, "b", "a") Exit For End If Next ibbb ' '231-240 Dim ibbbb&, ubbbb&, ybbbb&: ybbbb = 230 For ibbbb = 2 To 21 ubbbb = 1 If ibbbb Mod 2 = 0 Then ybbbb = ybbbb + 1: ubbbb = 2 If Cells(143, ibbbb) = [B2] Then [b5].Value = ybbbb & Choose(ubbbb, "b", "a") Exit For End If Next ibbbb ' '241-250 Dim ibbbbb&, ubbbbb&, ybbbbb&: ybbbbb = 240 For ibbbbb = 2 To 21 ubbbbb = 1 If ibbbbb Mod 2 = 0 Then ybbbbb = ybbbbb + 1: ubbbbb = 2 If Cells(149, ibbbbb) = [B2] Then [b5].Value = ybbbbb & Choose(ubbbbb, "b", "a") Exit For End If Next ibbbbb ' '251-260 Dim ibbbbbb&, ubbbbbb&, ybbbbbb&: ybbbbbb = 250 For ibbbbbb = 2 To 21 ubbbbbb = 1 If ibbbbbb Mod 2 = 0 Then ybbbbbb = ybbbbbb + 1: ubbbbbb = 2 If Cells(155, ibbbbbb) = [B2] Then [b5].Value = ybbbbbb & Choose(ubbbbbb, "b", "a") Exit For End If Next ibbbbbb ' '261-270 Dim ibbbbbbb&, ubbbbbbb&, ybbbbbbb&: ybbbbbbb = 260 For ibbbbbbb = 2 To 21 ubbbbbbb = 1 If ibbbbbbb Mod 2 = 0 Then ybbbbbbb = ybbbbbbb + 1: ubbbbbbb = 2 If Cells(161, ibbbbbbb) = [B2] Then [b5].Value = ybbbbbbb & Choose(ubbbbbbb, "b", "a") Exit For End If Next ibbbbbbb ' '271-280 Dim ibbbbbbbb&, ubbbbbbbb&, ybbbbbbbb&: ybbbbbbbb = 270 For ibbbbbbbb = 2 To 21 ubbbbbbbb = 1 If ibbbbbbbb Mod 2 = 0 Then ybbbbbbbb = ybbbbbbbb + 1: ubbbbbbbb = 2 If Cells(167, ibbbbbbbb) = [B2] Then [b5].Value = ybbbbbbbb & Choose(ubbbbbbbb, "b", "a") Exit For End If Next ibbbbbbbb ' '281-290 Dim ibbbbbbbbb&, ubbbbbbbbb&, ybbbbbbbbb&: ybbbbbbbbb = 280 For ibbbbbbbbb = 2 To 21 ubbbbbbbbb = 1 If ibbbbbbbbb Mod 2 = 0 Then ybbbbbbbbb = ybbbbbbbbb + 1: ubbbbbbbbb = 2 If Cells(173, ibbbbbbbbb) = [B2] Then [b5].Value = ybbbbbbbbb & Choose(ubbbbbbbbb, "b", "a") Exit For End If Next ibbbbbbbbb ' '291-300 Dim ibbbbbbbbbb&, ubbbbbbbbbb&, ybbbbbbbbbb&: ybbbbbbbbbb = 290 For ibbbbbbbbbb = 2 To 21 ubbbbbbbbbb = 1 If ibbbbbbbbbb Mod 2 = 0 Then ybbbbbbbbbb = ybbbbbbbbbb + 1: ubbbbbbbbbb = 2 If Cells(179, ibbbbbbbbbb) = [B2] Then [b5].Value = ybbbbbbbbbb & Choose(ubbbbbbbbbb, "b", "a") Exit For End If Next ibbbbbbbbbb ' '301-310 Dim ic&, uc&, yc&: yc = 300 For ic = 2 To 21 uc = 1 If ic Mod 2 = 0 Then yc = yc + 1: uc = 2 If Cells(185, ic) = [B2] Then [b5].Value = yc & Choose(uc, "b", "a") Exit For End If Next ic ' '311-320 Dim icc&, ucc&, ycc&: ycc = 310 For icc = 2 To 21 ucc = 1 If icc Mod 2 = 0 Then ycc = ycc + 1: ucc = 2 If Cells(191, icc) = [B2] Then [b5].Value = ycc & Choose(ucc, "b", "a") Exit For End If Next icc ' '321-330 Dim iccc&, uccc&, yccc&: yccc = 320 For iccc = 2 To 21 uccc = 1 If iccc Mod 2 = 0 Then yccc = yccc + 1: uccc = 2 If Cells(197, iccc) = [B2] Then [b5].Value = yccc & Choose(uccc, "b", "a") Exit For End If Next iccc ' '331-340 Dim icccc&, ucccc&, ycccc&: ycccc = 330 For icccc = 2 To 21 ucccc = 1 If icccc Mod 2 = 0 Then ycccc = ycccc + 1: ucccc = 2 If Cells(203, icccc) = [B2] Then [b5].Value = ycccc & Choose(ucccc, "b", "a") Exit For End If Next icccc ' '341-350 Dim iccccc&, uccccc&, yccccc&: yccccc = 340 For iccccc = 2 To 21 uccccc = 1 If iccccc Mod 2 = 0 Then yccccc = yccccc + 1: uccccc = 2 If Cells(209, iccccc) = [B2] Then [b5].Value = yccccc & Choose(uccccc, "b", "a") Exit For End If Next iccccc ' '351-360 Dim icccccc&, ucccccc&, ycccccc&: ycccccc = 350 For icccccc = 2 To 21 ucccccc = 1 If icccccc Mod 2 = 0 Then ycccccc = ycccccc + 1: ucccccc = 2 If Cells(215, icccccc) = [B2] Then [b5].Value = ycccccc & Choose(ucccccc, "b", "a") Exit For End If Next icccccc ' '361-370 Dim iccccccc&, uccccccc&, yccccccc&: yccccccc = 360 For iccccccc = 2 To 21 uccccccc = 1 If iccccccc Mod 2 = 0 Then yccccccc = yccccccc + 1: uccccccc = 2 If Cells(221, iccccccc) = [B2] Then [b5].Value = yccccccc & Choose(uccccccc, "b", "a") Exit For End If Next iccccccc ' '371-380 Dim icccccccc&, ucccccccc&, ycccccccc&: ycccccccc = 370 For icccccccc = 2 To 21 ucccccccc = 1 If icccccccc Mod 2 = 0 Then ycccccccc = ycccccccc + 1: ucccccccc = 2 If Cells(227, icccccccc) = [B2] Then [b5].Value = ycccccccc & Choose(ucccccccc, "b", "a") Exit For End If Next icccccccc ' '381-390 Dim iccccccccc&, uccccccccc&, yccccccccc&: yccccccccc = 380 For iccccccccc = 2 To 21 uccccccccc = 1 If iccccccccc Mod 2 = 0 Then yccccccccc = yccccccccc + 1: uccccccccc = 2 If Cells(233, iccccccccc) = [B2] Then [b5].Value = yccccccccc & Choose(uccccccccc, "b", "a") Exit For End If Next iccccccccc ' '391-400 Dim icccccccccc&, ucccccccccc&, ycccccccccc&: ycccccccccc = 390 For icccccccccc = 2 To 21 ucccccccccc = 1 If icccccccccc Mod 2 = 0 Then ycccccccccc = ycccccccccc + 1: ucccccccccc = 2 If Cells(239, icccccccccc) = [B2] Then [b5].Value = ycccccccccc & Choose(ucccccccccc, "b", "a") Exit For End If Next icccccccccc ' '401-410 Dim id&, ud&, yd&: yd = 400 For id = 2 To 21 ud = 1 If id Mod 2 = 0 Then yd = yd + 1: ud = 2 If Cells(245, id) = [B2] Then [b5].Value = yd & Choose(ud, "b", "a") Exit For End If Next id ' '411-420 Dim idd&, udd&, ydd&: ydd = 410 For idd = 2 To 21 udd = 1 If idd Mod 2 = 0 Then ydd = ydd + 1: udd = 2 If Cells(251, idd) = [B2] Then [b5].Value = ydd & Choose(udd, "b", "a") Exit For End If Next idd ' '421-430 Dim iddd&, uddd&, yddd&: yddd = 420 For iddd = 2 To 21 uddd = 1 If iddd Mod 2 = 0 Then yddd = yddd + 1: uddd = 2 If Cells(257, iddd) = [B2] Then [b5].Value = yddd & Choose(uddd, "b", "a") Exit For End If Next iddd ' '431-440 Dim idddd&, udddd&, ydddd&: ydddd = 430 For idddd = 2 To 21 udddd = 1 If idddd Mod 2 = 0 Then ydddd = ydddd + 1: udddd = 2 If Cells(263, idddd) = [B2] Then [b5].Value = ydddd & Choose(udddd, "b", "a") Exit For End If Next idddd ' '441-450 Dim iddddd&, uddddd&, yddddd&: yddddd = 440 For iddddd = 2 To 21 uddddd = 1 If iddddd Mod 2 = 0 Then yddddd = yddddd + 1: uddddd = 2 If Cells(269, iddddd) = [B2] Then [b5].Value = yddddd & Choose(uddddd, "b", "a") Exit For End If Next iddddd ' '451-460 Dim idddddd&, udddddd&, ydddddd&: ydddddd = 450 For idddddd = 2 To 21 udddddd = 1 If idddddd Mod 2 = 0 Then ydddddd = ydddddd + 1: udddddd = 2 If Cells(275, idddddd) = [B2] Then [b5].Value = ydddddd & Choose(udddddd, "b", "a") Exit For End If Next idddddd ' '461-470 Dim iddddddd&, uddddddd&, yddddddd&: yddddddd = 460 For iddddddd = 2 To 21 uddddddd = 1 If iddddddd Mod 2 = 0 Then yddddddd = yddddddd + 1: uddddddd = 2 If Cells(281, iddddddd) = [B2] Then [b5].Value = yddddddd & Choose(uddddddd, "b", "a") Exit For End If Next iddddddd ' '471-480 Dim idddddddd&, udddddddd&, ydddddddd&: ydddddddd = 470 For idddddddd = 2 To 21 udddddddd = 1 If idddddddd Mod 2 = 0 Then ydddddddd = ydddddddd + 1: udddddddd = 2 If Cells(287, idddddddd) = [B2] Then [b5].Value = ydddddddd & Choose(udddddddd, "b", "a") Exit For End If Next idddddddd ' '481-490 Dim iddddddddd&, uddddddddd&, yddddddddd&: yddddddddd = 480 For iddddddddd = 2 To 21 uddddddddd = 1 If iddddddddd Mod 2 = 0 Then yddddddddd = yddddddddd + 1: uddddddddd = 2 If Cells(293, iddddddddd) = [B2] Then [b5].Value = yddddddddd & Choose(uddddddddd, "b", "a") Exit For End If Next iddddddddd ' '491-500 Dim idddddddddd&, udddddddddd&, ydddddddddd&: ydddddddddd = 490 For idddddddddd = 2 To 21 udddddddddd = 1 If idddddddddd Mod 2 = 0 Then ydddddddddd = ydddddddddd + 1: udddddddddd = 2 If Cells(299, idddddddddd) = [B2] Then [b5].Value = ydddddddddd & Choose(udddddddddd, "b", "a") Exit For End If Next idddddddddd End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro recorded... tabs & file names changed, macro hangs | Excel Worksheet Functions | |||
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort | Excel Worksheet Functions | |||
Need syntax for RUNning a Word macro with an argument, called from an Excel macro | Excel Programming | |||
how to count/sum by function/macro to get the number of record to do copy/paste in macro | Excel Programming | |||
Start Macro / Stop Macro / Restart Macro | Excel Programming |