VBA stops running when value is written in a cell - vba

I am organizing a dirty text in an organised table. And this code stops when the cell the marked line is completed. Can you help me to make it continuing the loop?
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim sh7 As Worksheet
Dim CNAME As String
Set sh = Worksheets("Sheet6")
Set sh7 = Worksheets("Sheet7")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For n = 1 To lr
If InStr(1, sh.Cells(n, 1), "CALL:") = 1 Then
CNAME = sh.Cells(n, 7).Value
Ci = sh.Cells(n + 1, 7).Value
Cpd = sh.Cells(n + 1, 7).Value
Else
If InStr(1, sh.Cells(n, 1), "Topic:") = 1 Then
T = sh.Cells(n, 2)
Tpd = sh.Cells(n + 1, 2)
Types = sh.Cells(n + 4, 2)
DM = sh.Cells(n + 5, 2)
D = sh.Cells(n + 5, 4)
OD = sh.Cells(n + 6, 2)
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
sh7.Cells(lr7 + 1, 1).Value = CNAME '********This is the last line it runs.
sh7.Cells(lr7 + 1, 2).Value = Ci
sh7.Cells(lr7 + 1, 3).Value = Cpd
sh7.Cells(lr7 + 1, 4).Value = T
sh7.Cells(lr7 + 1, 5).Value = Tpd
sh7.Cells(lr7 + 1, 6).Value = Types
sh7.Cells(lr7 + 1, 7).Value = DM
sh7.Cells(lr7 + 1, 8).Value = D
sh7.Cells(lr7 + 1, 9).Value = OD
End If
End If
Next n
End Sub

You should get in the habit of defining all variables and supplying a default value.
EDIT:
It seems my original conclusion was incorrect. Upon further inspection I see what might be an issue in your code. Both times where you are trying to get the last row, you are using Rows.Count as a parameter.
Maybe change these
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
To this (note that I use the sheet variable in the first param)
lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(sh7.Rows.Count, 1).End(xlUp).Row

Related

button different from Module?

Private Sub CommandButton1_Click()
Dim nbp As Long
Dim i As Long
Dim p As Long
Dim FV As Variant
Dim CS As Variant
Dim K As Variant
Dim iFV As Integer
Dim iCS As Double
If Range("B9") = "Semi-Annual" Then
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 2
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 6, Cells(i, 10).Value)
Next i
For i = 6 To nbp + 5
Cells(i, 14).Value = Cells(7, 2).Value * (Cells(8, 2).Value / 2)
Next i
FV = Sheet2.Range("J5:J10").Value
CS = Sheet3.Range("F1:G8000").Value
For iFV = 1 To UBound(FV)
For iCS = 1 To UBound(CS, 2)
If FV(iFV, 1) = CS(iCS, 1) Then
K(iFV, 1) = CS(iCS, 2)
End If
Next
Next
Sheet2.Range("K5:K10").Value = K
End If
End If
If Range("B9") = "Annual" Then
nbp = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 12, Cells(i, 10).Value)
Next i
End if
If Range("B9") = "Quarterly" Then
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 4
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 3, Cells(i, 10).Value)
Next i
End If
If Range("B9") = "Monthly" Then ' to choose from a list .
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 12
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 3, Cells(i, 10).Value)
Next i
End If
End Sub
I have added all the code in the button to help. i am not sure if that will help, anyway here is it. if the user chooses semi annual then couple of things take place. Same goes for the rest "ifs" but i need to fix this issue first then move on to the rest. the code to too long, it is simple and not complicated.
Now that more of the code is posted, I think I understand what the problem is.
Wherever you reference Cells() VBA assumes it applies to ActiveSheet. And I think you should fully qualify the calls to be Sheet2.Cells() for example or whatever you need.
When you call the code behind a button, the button resides on a sheet and it references the cells on that sheet. But when you moved the code to a module it no longer referenced the sheet with the button, but whatever other sheet was active at the time.
So whenever you see Cells() or Range() without a worksheet specification in front of it, change it so that it you target a specific worksheet.
PS. Avoid using Integer and prefer Long instead. Also, prefer relative referencing such as Sheet2.Range("G2").Cells(i,j) instead of absolute referencing Sheet2.Cells(1+i, 6+j) or string math such as Sheet2.Range("G" & 1+i & ":G" & 5+i).

runtime error accured when I run a VBA script to create a simple report out of text output in blocks

Sub blockofdatatoreport()
Dim i As Integer
Dim x As Integer
Dim y As Integer
For i = 1 To 95
actvrw = Sheet1.Range("A:A").Find(what = i, searchdirection = xlNext).Row
'searching cells top to bottom
lr = Sheet2.Range("A:A").Find(what = "*", searchdirection = xlprevious).Row + 1
'searching cells bottom to top
For x = 1 To 5
Sheet2.Cells(lr, 1).Value = Sheet1.Cells(actvrw + (x - 1), 3).Value
'looping the first five columns in sheet2
Next
For y = 1 To 4
Sheet2.Cells(lr, 5 + y).Value = Sheet1.Cells(actvrw + (y - 1), 6).Value
'looping the next four columns after the first four is done in sheet2
Next
'You can also write like this or write a loop in two lines above.
'Sheet2.Cells(lr, 1).Value = Sheet1.Cells(actvrw, 3).Value
'Sheet2.Cells(lr, 2).Value = Sheet1.Cells(actvrw + 1, 3).Value
'Sheet2.Cells(lr, 3).Value = Sheet1.Cells(actvrw + 2, 3).Value
'Sheet2.Cells(lr, 4).Value = Sheet1.Cells(actvrw + 3, 3).Value
'Sheet2.Cells(lr, 5).Value = Sheet1.Cells(actvrw + 4, 3).Value
Next
End Sub
I get error called error 13 y type mismatch, what is in the above code causing the error??

Excel vba For Each & For loop

lastColumn_Of_PO_line_Big_Table = Sheets("PO_line_Big_Table").UsedRange.Columns.Count + 1
a = Dict_Metadata.Keys
For Each b In a
For i = 1 To UBound(Arr_PO_line_Big_Table)
If Arr_PO_line_Big_Table(i, 1) = b Then
With Worksheets("PO_line_Big_Table")
nextRow = Sheets("Final_Result").Cells(Sheets("Final_Result").Rows.Count, 1).End(xlUp).row + 1
'.Cells(nextRow, "A") = strKey
'.Cells(i + 1, lastColumn_Of_PO_line_Big_Table) = "YES"
Union(.Cells(i + 1, "E"), .Cells(i + 1, "K"), .Cells(i + 1, "L"), .Cells(i + 1, "M")).Copy
Sheets("Final_Result").Range("B" & nextRow).PasteSpecial
End With
End If
Next
Next
Could someone please tell me why it doesn't paste the value in sheet "PO_line_Big_Table" to sheet Final_Result, thank you in advanced!!

index match return NA value

I have a vba code that find the value at the intersection of columns and rows.
It works well with all my data except for one : it returns NA.
The value i want to return is the same as usual, it just doesn't work with this intersection.
Can you help me figure out why?
Thank you
With Perftitres
Set VMt = Data1.Range("U:U")
Set Ticker = Data1.Range("H:H")
End With
' Calculs de perf
For Each sht In Perftitres.Worksheets
If sht.Visible = True Then
If sht.Cells(1, 1) = "" Then
sht.Cells(1, 1) = "Date"
sht.Cells(1, 2) = "Code du placement"
sht.Cells(1, 3) = "Valeur marchande t"
sht.Cells(1, 4) = "Valeur marchande t-1"
sht.Cells(1, 5) = "Valeur des achats"
sht.Cells(1, 6) = "Valeur des ventes"
sht.Cells(1, 7) = "Facteur"
sht.Cells(1, 8) = "Rendement 1 mois"
End If
LastRowsht = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
LastColumnsht = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
sht.Cells(LastRowsht + 1, 1) = 20 & Left(Dateupdate, 2) & "-" & Right(Dateupdate, 2)
sht.Cells(LastRowsht + 1, 2) = sht.Name
sht.Cells(LastRowsht + 1, 3) = Application.Index(VMt, Application.Match(sht.Cells(LastRowsht + 1, 2), Ticker))
End If
Next sht
Data1.Visible = True
Data2.Visible = True
This line doesn't work as expected for only one sheet. For every other one it works.
sht.Cells(LastRowsht + 1, 3) = Application.Index(VMt, Application.Match(sht.Cells(LastRowsht + 1, 2), Ticker))
I just found the answer :
sht.Cells(LastRowsht + 1, 3) = Application.Index(VMt, Application.Match(sht.Cells(LastRowsht + 1, 2), Ticker,0),0)
I had to had 0 and 0 for exact matches

How to copy-paste in macro excel (VBA)

I need to copy a lot of rows. I tried to do something.copy something else.paste but it's extremely slow
I tried to do
Range(..).value(formula) = Range(..).value(formula) but its not so good because i have a date there that turn to ######
I need a faster way to do this copy/paste
This is my code:
Function Last_Col(k As Long) As Long
Last_Col = Cells(k, Columns.Count).End(xlToLeft).Column
End Function
Function Last_Col_Doc() As Long
Last_Col_Doc = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Column
End Function
Function Is_Grouped(i As Long) As Boolean
Is_Grouped = (Cells(i, 2).Rows.OutlineLevel > 1)
End Function
Function Is_Bold(i As Long) As Boolean
Is_Bold = Cells(i, 2).Font.Bold
End Function
Function Print_NA(i As Long, k As Long) As Boolean
Range(Cells(i, 21), Cells(i, 21 + k - 2)).Value = "NA"
End Function
Function Last_Row() As Long
Last_Row = Cells(Rows.Count, "B").End(xlUp).Row
End Function
Sub EditParanoia()
Dim FrstBlkRow As Long
Dim flag As Boolean
Dim i As Long
Dim HeadLen As Long
FrstBlkRow = Last_Col(1) + 1
If FrstBlkRow < 25 Then 'first edit
flag = True
i = 2
Do While flag
If Is_Bold(i) Then
flag = False
Else
i = i + 1
End If
Loop
HeadLen = Last_Col(i)
Range(Cells(i, 2), Cells(i, HeadLen)).Copy
Range(Cells(1, FrstBlkRow), Cells(1, FrstBlkRow + HeadLen - 2)).PasteSpecial
Else
FrstBlkRow = 21
HeadLen = 10
End If
Dim j As Long
For i = 2 To Last_Row Step 1
If Not Is_Grouped(i) And Not Is_Grouped(i + 1) And Cells(i, FrstBlkRow + 1).Value = vbNullString Then
'if not part of group
Range(Cells(i, FrstBlkRow), Cells(i, FrstBlkRow + HeadLen - 2)).Value = "NA"
ElseIf Not Is_Grouped(i) And Is_Grouped(i + 1) And Is_Grouped(i + 2) And Not Is_Grouped(i + 3) Then
'if Part of group of 1 val
Range(Cells(i + 2, 2), Cells(i + 2, 2 + HeadLen - 2)).Copy
Range(Cells(i, FrstBlkRow), Cells(i, FrstBlkRow + HeadLen - 3)).PasteSpecial
ElseIf Not Is_Grouped(i) And Is_Grouped(i + 1) Then
'if part of group of more then one val
j = 1
Do Until Is_Grouped(i + j) And Not Is_Grouped(i + j + 1)
'j will get the langth of any group
j = j + 1
Loop
'past the relevant cell in the right place
Range(Cells(i + 2, 2), Cells(i + 2 + j - 1 - 1, 2 + HeadLen - 2)).Copy
Range(Cells(i, FrstBlkRow), Cells(i + j - 1 - 1, FrstBlkRow + HeadLen - 3)).PasteSpecial
'past the head respectively
Range(Cells(i, 1), Cells(i, 20)).Copy
Range(Cells(i + 1, 1), Cells(i + j - 2, FrstBlkRow - 1)).PasteSpecial
End If
Next
End Sub
When you say you've tried "Range(..).value(formula) = Range(..).value(formula)", what do you mean? You should be able to set two ranges equal to eachother:
Say A1:A10 has "Batman, 10-01-2015" and you want to copy that range to B1:B10, Range("B1:B10").Value = Range("A1:A10").Value. You can't do that? I tried it with dates, and it set the B range values to dates, no reformatting necessary.
I also notice in your code, you PasteSpecial, but don't specify what type of special paste. See the Microsoft (or this one) page for more info.