Need to print a table of any numbers using VBA in excel. i.e blank row after each row . Below iswhat i wrote to print a table in consecutive rows, But i dont know how can i print the result in alternate rows?
Sub table()
a = InputBox("Enter first no")
ActiveSheet.Cells.Clear
ActiveSheet.Cells(5, 4) = "TABLE OF " & a
For i = 1 To 10
c = a * i
ActiveSheet.Cells(i + 5, 4) = a
ActiveSheet.Cells(i + 5, 5) = "*"
ActiveSheet.Cells(i + 5, 6) = i
ActiveSheet.Cells(i + 5, 7) = "="
ActiveSheet.Cells(i + 5, 8).Value = c
next i
End Sub
Sub table()
a = InputBox("Enter first no")
n As Integer
n=6
ActiveSheet.Cells.Clear
ActiveSheet.Cells(5, 4) = "TABLE OF " & a
For i = 1 To 10
c = a * i
ActiveSheet.Cells(n, 4) = a
ActiveSheet.Cells(n, 5) = "*"
ActiveSheet.Cells(n, 6) = i
ActiveSheet.Cells(n, 7) = "="
ActiveSheet.Cells(n, 8).Value = c
n = n + 2
next i
End Sub
Change your row number calculation from
i + 5
to
(i * 2) + 4
Related
I've got a code that keeps on returning a run-time error 1004 - Application-defined or object-defined error. I've tried stepping through the individual parts of the worksheetfunction.countif function, and they all work fine separately.
However, when I put them together, they fail.
The code is:
s = 2
While Cells(s - 1, 1) <> vbNullString
Rows(s & ":" & s + 3).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cells(s, 1), Cells(s + 3, 1)).Select
Selection.Rows.Group
Cells(s, 1) = "A"
Cells(s + 1, 1) = "B"
Cells(s + 2, 1) = "C"
Cells(s + 3, 1) = "D"
r = 3
q = vbNullString
p = vbNullString
n = s
While n < s + 5
While r <= v
M = 1
If Cells(n, 1) = "A" Then
q = 5
p = 12
ElseIf Cells(n, 1) = "B" Then
q = 18
p = 25
ElseIf Cells(n, 1) = "C" Then
q = 31
p = 38
ElseIf Cells(n, 1) = "D" Then
q = 44
p = 51
End If
While M <= u
l = vbNullString
l = WorksheetFunction.CountIf(Worksheets("IT Teams").Range(Cells(q, M), Cells(p, M)), Worksheets("Players IT").Cells(s + 4, 1))
If Not IsError(l) Then
Cells(n, r) = l
Else
Cells(n, r) = vbNullString
End If
M = M + 5
r = r + 1
Wend
Wend
n = n + 1
r = 3
Wend
s = s + 5
Wend
All variables have been declared as Variants.
Edit: for clarity. Error occurs at:
l = WorksheetFunction.CountIf(Worksheets("IT Teams").Range(Cells(q, M), Cells(p, M)), Worksheets("Players IT").Cells(s + 4, 1))
The problem is the way you declare the ranges. You should always include the sheet, otherwise you get this error, if you use more than one sheet (or if you use one, but it is not the active one).
Like this:
With ActiveSheet
While Cells(s - 1, 1) <> vbNullString
.Rows(s & ":" & s + 3).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range(.Cells(s, 1), .Cells(s + 3, 1)).Select
Selection.Rows.Group
.Cells(s, 1) = "A"
.Cells(s + 1, 1) = "B"
.Cells(s + 2, 1) = "C"
.Cells(s + 3, 1) = "D"
Wend
End With
Pay attention to the dots.
In general, declare the sheets and then use them:
'Option Explicit - start using option explicit
Sub test()
Dim wksA As Worksheet
Dim wksIT As Worksheet
Set wksA = ThisWorkbook.ActiveSheet
Set wksIT = ThisWorkbook.Worksheets("IT Teams")
s = 2
While Cells(s - 1, 1) <> vbNullString
wksA.Rows(s & ":" & s + 3).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wksA.Range(wksA.Cells(s, 1), wksA.Cells(s + 3, 1)).Select
Selection.Rows.Group
wksA.Cells(s, 1) = "A"
wksA.Cells(s + 1, 1) = "B"
wksA.Cells(s + 2, 1) = "C"
wksA.Cells(s + 3, 1) = "D"
Wend
With wksIT
While M <= u
l = vbNullString
l = WorksheetFunction.CountIf(.Range(.Cells(q, M), _
.Cells(p, M)), .Cells(s + 4, 1))
If Not IsError(l) Then
.Cells(n, r) = l
Else
.Cells(n, r) = vbNullString
End If
M = M + 5
r = r + 1
Wend
End With
End Sub
Concerning your case, I am about 80% sure, that you get the error somewhere here:
l = WorksheetFunction.CountIf(Range(Cells(q, M), Cells(p, M)), Cells(s + 4, 1))
In general, never assume which worksheet your code is operating on and explicitly define it in your code.
Concerning the place where you get the error, it should be simply like this:
Set wksA = ThisWorkbook.ActiveSheet
Set wksIT = ThisWorkbook.Worksheets("IT Teams")
Set wksPl = ThisWorkbook.Worksheets("SomePlayers")
l = WorksheetFunction.CountIf(wksIT.Range(wksIT.Cells(q, M), wksIT.Cells(p, M)), _
wksPl.Cells(s + 4, 1))
I have a great problem. I have a macro that does not run since the last week and I do not know why? I'm getting always the error: "Runtime Error 9 ...."
I know there must be a problem with the renames or arrays but I do not find anything.
Could you please check this code, maybe you can find the problem.
Thanks in advance!
Regards, Krisztian
It is just a part of the big macro.
The error is in the 8th row when "k" would be = "10"
Ubound is teoretically "9" (??)
EditRow(k) = EditRow(k) + (insdels * (k - 1))
'Populate input sheet
insdels = 0
For i = 1 To UBound(EditRow)
If FAT_Blocks(i).Range_Name <> "Absent_from_BCM" Then ' only process the blocks that were present
k = FAT_Blocks(i).GPI_Block_Number 'ERROR***************************************************************************
EditRow(k) = EditRow(k) + (insdels * (k - 1))
For m = 1 To FAT_Blocks(i).Rows
If FAT_Blocks(i).Data(m, 1) <> 0 Then ' ignore rows with zero cost/revenue in year 1
If GPIsheet.Cells(EditRow(k), 2).Interior.ColorIndex <> new_CI Then
new_InsDel (1)
insdels = insdels + 1
EditRow(k) = EditRow(k) + (k - 1)
End If
If FAT_Blocks(i).Row_Title(m) Like "*One Time*" Then
y = 0
ElseIf FAT_Blocks(i).Row_Title(m) Like "*Recurring*" Then
y = 1
Else
y = 2
End If
With GPIsheet
.Range("Original_Import_Data").Offset(EditRow(k) - 1, 0).ClearContents ' clear any mung before updating
' fill the "new_CI" coloured cells on the left
.Cells(EditRow(k), 2).value = BCMid & " " & FAT_Blocks(i).Row_Title(m) ' row description
.Cells(EditRow(k), 3).value = FAT_Blocks(i).Data(m, 1) ' unit value
.Cells(EditRow(k), 4).value = change_pc(y) ' change %
.Cells(EditRow(k), 5).value = change_year(y) ' change year
.Cells(EditRow(k), 6).value = vol_driver(y) ' volume driver
' fill the grey stuff on the right
With .Range("Original_Import_Data").Offset(EditRow(k) - 1, 0)
.Cells(1, 1) = yr ' Contract length
.Cells(1, 2) = BCMid ' BCM unique id
For j = 1 To yr
.Cells(1, 2 + j) = FAT_Blocks(i).Data(m, j) ' data for corresponding year
Next
End With
End With
EditRow(k) = EditRow(k) + 1
End If
Next m
End If
Next i
I am having a little trouble figuring out a macro to help me with some of my data. I have come across a couple macro's that almost do what I need, but I don't know enough about the language yet to figure it out. This is what I am working with.
Column A - List of software.
Column B - Version of software.
Column C - Computer names it is installed on.
What I am looking for. I need a macro to search for duplicates that match both Column A and B. If it has a duplicate, I need it to copy the duplicates and original rows to Sheet2.
Now Sheet2 should only have duplicate items on it. Would it be possible to search for duplicates again (Column A&B), when it gets a match, JoinRange of the Column C's together. Then delete the duplcates.
Ex:
Column A (Software)
Adobe Reader X
Adobe Reader X
Adobe Reader X
Adobe Reader XI
Adobe Reader XI
Column B (Version)
10.1.6
10.1.6
10.1.7
11.0.03
11.0.03
Column C (Computers)
Computer1,Computer2
Computer3,Computer4
Computer5,Computer6
Computer7,Computer8
Computer9,Computer10
Finished product would be:
Column A
Adobe Reader X
Adobe Reader X
Adobe Reader XI
Column B
10.1.6
10.1.7
11.0.03
Column C
Computer1,Computer2,Computer3,Computer4
Computer5,Computer6
Computer7,Computer8,Computer9,Computer10
I'm not sure if this is possible, but I could sure use some guidance.
V/r,
Brett
Pretty simple. Add a sheet called "Duplicates", then select the sheet you want to check for duplicates, then make sure the sheet is sorted first by col A next by Col B, then run this macro:
Sub GetDuplicates()
On Error GoTo errGetDuplicates
d = 1
x = 1
Do Until Cells(x, 1) = "" 'Looks at each row until it reaches the end
If Cells(x, 1) = Cells(x + 1, 1) Then 'Checks Col 1 for duplicates
If Cells(x, 2) = Cells(x + 1, 2) Then 'Checks Col 2 for duplicates
Sheets("Duplicates").Cells(d, 1) = Cells(x, 1)
Sheets("Duplicates").Cells(d, 2) = Cells(x, 2)
Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
d = d + 1
x = x + 1
Sheets("Duplicates").Cells(d, 1) = Cells(x, 1)
Sheets("Duplicates").Cells(d, 2) = Cells(x, 2)
Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
d = d + 1
End If
End If
doneWithError:
x = x + 1
Loop
Exit Sub
errGetDuplicates:
If Err = 1004 Then
array1 = Split(Cells(x, 1), " ")
array2 = Split(Cells(x + 1, 1), " ")
For a = 0 To UBound(array1)
If Not array1(a) = array2(a) Then GoTo unmatched
Next a
array3 = Split(Cells(x, 2), " ")
array4 = Split(Cells(x + 1, 2), " ")
For a = 0 To UBound(array1)
If Not array3(a) = array4(a) Then GoTo unmatched
Next a
Sheets("Duplicates").Cells(d, 1) = Join(array1, " ")
Sheets("Duplicates").Cells(d, 2) = Join(array3, " ")
Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
d = d + 1
x = x + 1
Sheets("Duplicates").Cells(d, 1) = Join(array2, " ")
Sheets("Duplicates").Cells(d, 2) = Join(array4, " ")
Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
d = d + 1
GoTo doneWithError
End If
End Sub
So I've gone over this code for the best part of 4 hours fiddling with it, rewriting from scratch. The only thing I got out of this was the reduction in the code from about 15 lines to the now 9.
Anyways, the problem with the code is that it is not properly recognizing the arrDateTime date with the intArrayIndex-1. Instead of the normal date say "June 7, 2013", which I can retrieve inside the k=0 if statement, it comes back with "December 30, 1899" which I read occurs when the date statement is incorrect.
Also, I've tried using specific numbers just to test them out and it has no problem in the j=0 portion, however, for some reason the j=1 statement didn't work. I've also tried simplyfying the code by having the 1-j instead of the 1 in the DateAdd variable, however it doesn't want to add no days.
'grabs date and time
If (k = 0) Then
intDay = Cells(intRowNum + 2, 2).Value
arrDateTime(intArrayIndex) = DateValue(strMonth & " " & intDay & ", " & intYear) + (Cells(intRowNum + intMaxRows + 3, 1).Value)
ElseIf j = 0 Then
arrDateTime(intArrayIndex) = DateAdd("d", 1, arrDateTime(intArrayIndex - 1))
ElseIf j = 1 Then
arrDateTime(intArrayIndex) = arrDateTime(intArrayIndex - 1)
End If
I'm getting desperate here, any help whatsoever in figuring out why the date variable is incorrectly used would be greatly appreciated.
Update 1
As requested I have included absolutely every piece of code relative to the problem, I didn't include everything as it's 400+ lines long.
Dim intRowNum As Integer
Dim intMaxRows As Integer
Dim intArrayIndex As Integer
Dim intYear As Integer
Dim intDay As Integer
Dim strMonth As String
Dim arrTitle(0 To 9) As String
Dim arrDescription(0 To 9) As String
Dim arrProf(0 To 9) As String
Dim arrDateTime(9) As Date
For j = 0 To 1
For k = 0 To 4
intArrayIndex = k * 2 + j
'grabs date and time
If (k = 0) Then
intDay = Cells(intRowNum + 2, 2).Value
arrDateTime(intArrayIndex) = DateValue(strMonth & " " & intDay & ", " & intYear) + (Cells(intRowNum + intMaxRows + 3, 1).Value)
ElseIf j = 0 Then
arrDateTime(intArrayIndex) = DateAdd("d", 1, arrDateTime(intArrayIndex - 1))
ElseIf j = 1 Then
arrDateTime(intArrayIndex) = arrDateTime(intArrayIndex - 1)
End If
Next
Next
For j = 0 To 9
ActiveSheet.Cells(3 + j, 1).Value = j + 1
ActiveSheet.Cells(3 + j, 5).Value = TimeValue(arrDateTime(j))
ActiveSheet.Cells(3 + j, 6).Value = MonthName(month(arrDateTime(j)))
ActiveSheet.Cells(3 + j, 7).Value = Day(arrDateTime(j))
ActiveSheet.Cells(3 + j, 8).Value = Year(arrDateTime(j))
Next
Your iteration goes as follows:
Turn j k intArrayIndex arrDateTime(intArrayIndex)
1 0 0 0 is created your date on first array position
2 0 1 2 arrDateTime(2 -1) does not exist, it is empty/zero!!
therefore trying to add 1 day to zero result with what you have.
I've created a particularly long vba macro to edit a large spreadsheet of data for me instead of doing it myself thousands of times. The code for the actual editing works fine, however, when I add in the first if statements and first while loop to make it loop through the whole spreadsheet, I get a runtime error 1004. I'm new to vba but I'm pretty sure there is an error in my logic rather than the code itself. I've marked which lines of code cause the error when added.
Sub RCFS()
Dim ProfCtr As String
Dim Year As String
Dim Amount As Currency
Dim Period As Long
Dim S2FreecellH As Long
Dim ProfCenCellH As Long
Dim FreeCellClone As Long
Dim Clone2 As Long
Dim Clone3 As Long
Dim y As Long ' placeholder 2
y = 1
S2FreecellH = 3
ProfCenCellH = 2
AmountH = 2
PeriodH = 2
YearH = 2
ProfCtr = Cells(ProfCenCellH, 4)
Year = Cells(YearH, 7)
Amount = Cells(AmountH, 8)
Period = Cells(PeriodH, 6)
'//////////////////////////////////////////////////////////////////////////////////
While IsEmpty(Cells(ProfCenCell, 4).Value) = False
Everything fine until this while loop (above) and if statement (below). The rest works fine without these 2 statements but I need it to loop through the whole spreadsheet.
If Cells(ProfCenCell, 4).Value = Worksheets("Sheet2").Cells(S2FreecellH, 1).Value Then
Worksheets("Sheet2").Cells(S2FreecellH, 1).Value = ProfCtr
Worksheets("Sheet2").Cells(S2FreecellH, 5).Value = ProfCtr
Worksheets("Sheet2").Cells(S2FreecellH, 9).Value = ProfCtr
FreeCellClone = S2FreecellH 'setting clones
Clone2 = S2FreecellH
Clone3 = S2FreecellH
For x = S2FreecellH + 1 To S2FreecellH + 12
Worksheets("Sheet2").Cells(x, 2).Value = y 'Creating 1 to 12 numbering in column 1
Worksheets("Sheet2").Cells(x, 6).Value = y 'Creating 1 to 12 numbering in column 2
Worksheets("Sheet2").Cells(x, 10).Value = y 'Creating 1 to 12 numbering in column 3
S2FreecellH = S2FreecellH + 1
y = y + 1
Next x
While Worksheets("Sheet2").Cells(FreeCellClone, 1).Value = Cells(YearH, 4).Value 'Loop to input all amounts
Worksheets("Sheet2").Cells(FreeCellClone + Period, (((Year Mod 11) * 4)) - 1).Value = Amount 'Calculation on post year to select correct column to post amount in
PeriodH = PeriodH + 1
AmountH = AmountH + 1
YearH = YearH + 1
Year = Cells(YearH, 7)
Amount = Cells(AmountH, 8)
Period = Cells(PeriodH, 6)
Wend
Worksheets("Sheet2").Cells(S2FreecellH + 1, 3) = WorksheetFunction.Sum(Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(FreeCellClone + 1, 3), Worksheets("Sheet2").Cells(S2FreecellH, 3)))
Worksheets("Sheet2").Cells(S2FreecellH + 1, 7) = WorksheetFunction.Sum(Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(FreeCellClone + 1, 7), Worksheets("Sheet2").Cells(S2FreecellH, 7))) 'Creating sums for all 3 columns
Worksheets("Sheet2").Cells(S2FreecellH + 1, 11) = WorksheetFunction.Sum(Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(FreeCellClone + 1, 11), Worksheets("Sheet2").Cells(S2FreecellH, 11)))
For Z = Clone2 + 1 To Clone2 + 12 'creating intitial percentage values
Worksheets("Sheet2").Cells(Z, 4).Value = Format((Worksheets("Sheet2").Cells(Z, 3) / Worksheets("Sheet2").Cells(S2FreecellH + 1, 3)) * 100, "%0.00")
Worksheets("Sheet2").Cells(Z, 8).Value = Format((Worksheets("Sheet2").Cells(Z, 7) / Worksheets("Sheet2").Cells(S2FreecellH + 1, 7)) * 100, "%0.00")
Worksheets("Sheet2").Cells(Z, 12).Value = Format((Worksheets("Sheet2").Cells(Z, 11) / Worksheets("Sheet2").Cells(S2FreecellH + 1, 11)) * 100, "%0.00")
Next
For q = Clone3 + 1 To Clone3 + 12 'creating final percentage values
Worksheets("Sheet2").Cells(q, 13).Value = Format(((Worksheets("Sheet2").Cells(q, 4) + Worksheets("Sheet2").Cells(q, 8) + Worksheets("Sheet2").Cells(q, 12)) / 3) * 100, "%0.00")
Next q
Worksheets("Sheet2").Cells(S2FreecellH + 1, 13) = WorksheetFunction.Sum(Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(FreeCellClone + 1, 13), Worksheets("Sheet2").Cells(S2FreecellH, 13)))
Else
ProfCenCell = ProfCenCell + 1
End If
'/////////////////////////////////////////////////////////////////////////////// Loop these Loops
S2FreecellH = S2FreecellH + 3
y = 1
Wend
End Sub
You never set a value for ProfCenCell, hence it has default value 0. Then, you use Cells(ProfCenCell, 4) which is in your case Cells(0, 4) and that 0 makes a problem.