I am new to writing in excel and coding in general. I wrote this to check if a corresponding cell was blank and if it wasn't, to loop through the array. If any of the array is present in the cell, then the target cell value will be "Y".
It gets through one row then stalls. I isolated the issue to be the for loop but I cannot figure out what is causing it to crash Excel. Any help is greatly appreciated.
Sub test()
Dim LR As Long, i As Long, j As Long, aNames
aNames = Array("this", "that", "the other")
Cells(2, 21).Activate
Do While Not IsEmpty(ActiveCell.Offset(, -15))
For j = LBound(aNames) To UBound(aNames)
On Error Resume Next
If ActiveCell.Offset(, -15).Value Like "*" & aNames(j) & "*" Then
ActiveCell.Value = "Y"
ActiveCell.Offset(1, 0).Activate
On Error GoTo Last
Else
End If
Next j
Loop
Last:
End Sub
Related
Manual - Select range, execute Sub
How it works - Sub saves all non-blank cells to finalArray that is ultimately displayed in the selected range
What's the problem - if range contains cells with hyperlinks created via insert-hyperlink, the hyperlinks disappear.
Sub RemoveBlanks()
'i,j - counters, k - offset
Dim finalArray() As Variant
ReDim finalArray(Selection.Rows.Count, 1)
k = 1
For i = 1 To Selection.Rows.Count
If Selection(i, 1) <> "" Then
finalArray(k, 1) = Selection(i, 1)
k = k + 1
End If
Next i
Application.ScreenUpdating = False
Application.EnableEvents = False
Selection.Clear
For i = 1 To k
Selection(i, 1).Value = finalArray(i, 1)
Next i
End Sub
This Code will loops through each cell in the selected range, checks if the cell has a hyperlink then temporarily grab and store the address that it’s pointing to re-apply the hyperlink
Option Explicit
Sub fixHyperlinks()
Dim rng As Range
Dim address As String
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Hyperlinks.Count > 0 Then
address = rng.Hyperlinks(rng.Hyperlinks.Count).address
rng.Hyperlinks.Add Anchor:=rng, _
address:=address
End If
Next
Application.ScreenUpdating = True
End Sub
After you run this code, you should be able to set in your array the range without losing your links.
Conclusion : Run this code before you run your macro.
So I have found a way around the issue after lurking through internet and trying to save links in another array (fails). It works only if the value in the cell is the same as name of a sheet, yet it solves my issue so far.
Sub CreateLinks()
'i - counter, the title as i=1 is omitted. Code uses value stored in cell to
'transform it into a link.
Dim i As Integer
For i = 2 To Selection.Rows.Count
If Selection(i) <> "" Then
ActiveSheet.Hyperlinks.Add anchor:=Selection(i), _
address:="#'" & CStr(Selection(i)) & "'!A1", _
TextToDisplay:=CStr(Selection(i))
End If
Next i
End Sub
I'm currently trying to use a Do Until within a For each but I'm having a problem. What I'm trying is to Do Until selection value equals the value selected for the For each section in the following code:
Private Sub Copiar()
Dim Eselect As Variant
Dim vItem As Variant
Dim Col As Integer
Eselect = Array(CBE1.Value, CBE2.Value, CBE3.Value, CBE4.Value, CBE5.Value)
For Each vItem In Eselect
Range("C2").Select
Do Until Selection.Value = vItem.Value
Selection.Offset(0, 1).Select
Loop
Col = ActiveCell.Column
Columns(Col).Copy
Sheets(2).Active
Range("A1").Select
If Range("A1") = "" Then
Columns(Col).Copy
Else
Do Until Selection.Value = ""
Offset.Selection(0, 1) = Selection.Value
Loop
Columns(Col).Copy
End If
Next
End Sub
The problem is specifically where is says "Do Until Selection.Value = vItem.Value" because I can't use vItem.Value and I don't know what I should use for to search until it find the value that For Each has selected. (I'm obviously just learning VBA).
The whole idea is for it to search a specific value (multiple times, one for each ComboBox Value: CBEi) in a row and return the column, then copy that column on another sheet.
Any help would be appreciated.
Vicente.
Proper syntax Match and If not isblank
I need some assistance with creating a loop statement that will determine the range start and end where a particular criteria is met.
I found these statements on the web and need help to modify them to loop thru two different worksheets to update a value on 1 of the worksheets.
This one has an issue returning True or False value for the Range when I want to pass the actual named range for look up where this field = Y, then returns the value from another column. I original tried using Match and If is not blank function. But that is very limiting.
See the previous post to see what I am trying to accomplish - I know I will need to expand the code samples and probably will need help with this modification.
Sub Test3()
Dim x As Integer
Dim nName As String
Sheets("BalanceSheet").Select
nName = Range("qryDifference[[Validate Adjustment]]").Select
Debug.PrintnName
' Set numrows = number of rows of data.
NumRows = Range(nName, Range(nName).End(xlDown)).Rows.Count
' Select cell a1.
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
' Insert your code here.
MsgBox"Value found in cell " & ActiveCell.Address
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
End Sub
This is what I have so far - this is giving me and issue with
ActiveCell.Offset(4, 0).Select
nAgentNo = Range("qryDifference[[agtno]]").Value
nValidate = Range("ryDifference[[Difference]]").Value
Debug.Print nAgentNo
Debug.Print nValidate
Type mismatch error on the above.
Sub Revised_AgentAmount()
Dim myRange As Range
Dim i As Long, j As Long
Dim nAgentNo As String
Dim nValidate As Long
Sheets("BalanceSheet").Select
Set myRange = Range("qryDifference[[Validate Adjustment]]")
For i = 1 To myRange.Rows.Count
For j = 1 To myRange.Columns.Count
If myRange(i, j).Value = "Y" Then
ActiveCell.Offset(4, 0).Select
nAgentNo = Range("qryDifference[[agtno]]").Value
nValidate = Range("ryDifference[[Difference]]").Value
Debug.Print nAgentNo
Debug.Print nValidate
End If
Next j
Next i
End Sub
In your first statement you declare nName as a String then try to select it. You would need to declare it as a Range if you are going to use it as a Range object.
I found solution elsewhere with a if statement instead of the for loop.
=IF([#agtno]=B24,[#[agt_amt]],SUMPRODUCT((Balance!$B$2:$B$7=[#agtno])*(Balance!$F$2:$F$7="Y")*Balance!$E$2:$E$7)+[#[agt_amt]])
I have the following macro that adds 0s to ID numbers until they are 7 numbers long. I have used it countless times before and it has always worked without fail until today it started not working and the portion of the code For i = 1 To endrow - 1 is highlighted every time and I cannot debug the issue. The whole code is.
Sub AddZeroes()
'Declarations
Dim i As Integer, j As Integer, endrow As Long
'Converts the A column format to Text format
Application.ScreenUpdating = False
Columns("A:A").Select
Selection.NumberFormat = "#"
'finds the bottom most row
endrow = ActiveSheet.Range("A1").End(xlDown).Row
'selects the top cell in column A
ActiveSheet.Range("A1").Select
'loop to move from cell to cell
For i = 1 To endrow - 1
'Moves the cell down 1. Assumes there's a header row so really starts at row 2
ActiveCell.Offset(1, 0).Select
'The Do-While loop keeps adding zeroes to the front of the cell value until it hits a length of 7
Do While Len(ActiveCell.Value) < 7
ActiveCell.Value = "0" & ActiveCell.Value
Loop
Next i
Application.ScreenUpdating = True
End Sub
Not sure what is causing the error - but would suggest another approach:
sub addZeros()
Application.ScreenUpdating = False
' start at row 2 since OP said there's a header row
Dim c as Range
for each c in Range("A2", [A2].End(xlDown))
c.Value = "'" & Format(c.Value, "00000000")
next c
Application.ScreenUpdating = True
end sub
A bit more compact...
Note that I'm adding the "'" apostrophe to make Excel treat the cell value as string. This is a safe way to make sure the zeros stay...
EDIT: Got rid of the last .Select to show it can be done, and is generally good practice as pointed out in comments.
I have an excel file which looks like this:
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3
How can i make three (or any number of) copies of each row that i have in the sheet, which i would like to be added after the row being copied? So, in the end i would like to have this kind of a result:
row1_cell1 row1_cell2 row1_cell3
row1_cell1 row1_cell2 row1_cell3
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row2_cell1 row2_cell2 row2_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3
row3_cell1 row3_cell2 row3_cell3
row3_cell1 row3_cell2 row3_cell3
This is how I would do that for all rows on the sheet:
Option Explicit
Sub MultiplyRows()
Dim RwsCnt As Long, LR As Long, InsRw As Long
RwsCnt = Application.InputBox("How many copies of each row should be inserted?", "Insert Count", 2, Type:=1)
If RwsCnt = 0 Then Exit Sub
LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For InsRw = LR To 1 Step -1
Rows(InsRw).Copy
Rows(InsRw + 1).Resize(RwsCnt).Insert xlShiftDown
Next InsRw
Application.ScreenUpdating = True
End Sub
There isn't a direct way to paste them interleaved like what you wanted. However, you can create a temporary VBA to do what you want.
For example, you can:-
Create a VBA procedure (like the one below) in your Excel file.
Assign a keyboard shortcut (eg. Ctrl+Q) to it.
To do this, press Alt+F8, then select the macro, then click 'Options'.
Select the cells you want to copy, then press Ctrl+C.
Select the cell you want to paste in, then press Ctrl+Q (or whatever keyboard shortcut you chose).
Enter the number of times you want to copy. (In your example, it would be 3.)
WHAMMO! :D
Now you can delete the VBA procedure. :)
VBA Code:
Sub PasteAsInterleave()
Dim startCell As Range
Dim endCell As Range
Dim firstRow As Range
Dim pasteCount As Long
Dim rowCount As Long
Dim colCount As Long
Dim i As Long
Dim j As Long
Dim inputValue As String
If Application.CutCopyMode = False Then Exit Sub
'Get number of times to copy.
inputValue = InputBox("Enter number of times to paste interleaved:", _
"Paste Interleave", "")
If inputValue = "" Then Exit Sub 'Cancelled by user.
On Error GoTo Error
pasteCount = CInt(inputValue)
If pasteCount <= 0 Then Exit Sub
On Error GoTo 0
'Paste first set.
ActiveSheet.Paste
If pasteCount = 1 Then Exit Sub
'Get pasted data information.
Set startCell = Selection.Cells(1)
Set endCell = Selection.Cells(Selection.Cells.count)
rowCount = endCell.Row - startCell.Row + 1
colCount = endCell.Column - startCell.Column + 1
Set firstRow = Range(startCell, startCell.Offset(0, colCount - 1))
'Paste everything else while rearranging rows.
For i = rowCount To 1 Step -1
firstRow.Offset(i - 1, 0).Copy
For j = 1 To pasteCount
startCell.Offset(pasteCount * i - j, 0).PasteSpecial
Next j
Next i
'Select the pasted cells.
Application.CutCopyMode = False
Range(startCell, startCell.Offset(rowCount * pasteCount - 1, colCount - 1)).Select
Exit Sub
Error:
MsgBox "Invalid number."
End Sub
Old thread, however someone might find this useful:
The below information was copied from here
I needed to do almost the opposite. I needed the formula to increment by 1 every 22 rows, leaving the 21 rows between blank. I used a modification of the formula above and it worked great. Here is what I used:
=IFERROR(INDIRECT("J"&((ROW()-1)*1/22)+1),"")
The information was in column "J".
The "IFERROR" portion handles the error received when the resulting row calculation is not an integer and puts a blank in that cell.
Hope someone finds this useful. I have been looking for this solution for a while, but today I really needed it.
Thanks.