Excel VBA Loop Rows Until Empty Cell - excel

I have an Excel document with some plain text in a row. The cells in the range A1:A5 contain texts, then a hundred of rows down there's another few rows with text. Cells between are empty.
I've set up a Do Until loop which is supposed to copy cells with text, and then stop when an empty cell appears. My loop counts and copies 136 cells including the 5 with text.
So my question is why?
The bottom line: Hello ends up on line 136, and then there's a huge gap of empty cells until next area with text. Do the 131 white cells contain any hidden formatting causing this?
I've tried "Clear Formats" and "Clear All". I've also tried using vbNullString instead of " ".
Code snippet:
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Integer, y As Integer
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
Do Until assets.Worksheets(1).Range("A" & x) = ""
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
x = x + 1
y = y + 1
Loop
test.Worksheets(1).Range("A" & x).Value = "Hello"
End Sub

Use a For Next Statement terminating in the last used cell in column A. Only increment y if there has been a value found and transferred and let the For ... Next increment x.
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Long, y As Long
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
with assets.Worksheets(1)
for x = 1 to .cells(rows.count, 1).end(xlup).row
if cbool(len(.Range("A" & x).value2)) then
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
y = y + 1
end if
next x
test.Worksheets(1).Range("A" & y).Value = "Hello"
end with
End Sub

Related

Show text if multiple cell values are True

I want a formula for column E3 depend on column A3,B3,C3 and D3. If multiple columns show yes or single column show yes I want show as below in pink. Need to combine shctin names which show "yes".Formula required for column E .End result shoul show as pink color.
Check it out
Sub Button1_Click()
Dim x, y, z
For x = 3 To 15
For y = 1 To 4
If UCase(Cells(x, y)) = "YES" Then
z = z & "_" & Cells(2, y)
End If
Next y
Cells(x, 5) = Right(z, Len(z) - 1)
z = ""
Next x
End Sub
User Defined Function,the function code belongs in a regular module.
Place this formula in E3 and drag down,
=Get_It(A3:D3,2)
Function Get_It(a As Range, Return_Row As String)
Dim c As Range
Dim s As String
For Each c In a.Cells
If UCase(c) = "YES" Then
s = s & "_" & Cells(Return_Row, c.Column)
End If
Next c
Get_It = Right(s, Len(s) - 1)
End Function
There's another way using formulas. A little ugly but ok as a non-VBA alternative.

Creating a list of named ranges for every sheet

There are many things similar but not exactly my issue. I'm trying to name ranges off of each tab based upon details of the tab name. I have placed the tab names in one sheet and now want to define named ranges based upon these cells. I can't get it to like my range names with a variable.
Sub Test()
Dim x As Integer
Dim y As String
Dim YY As String
Dim z As String
Dim ZZ As String
For x = 1 To Worksheets.Count
Sheets("List of Tab Names").Activate
y = Cells(x, 1).Value
z = Cells(x, 2).Value
YY = y & "Data2"
ZZ = z & "YoA2"
Sheets(y).Activate
Range("C9:BG233").Name = " ' " & YY & " ' "
Range("C7:BG7").Name = " ' " & ZZ & " ' "
Next x
End Sub
You don't need the single quotes around the range names. Just try:
Range("C9:BG233").Name = YY
Range("C7:BG7").Name = ZZ
If I have got your idea right i think all you are missing is the function Worksheets(sheetname)
As you can see in the code here:
Range("A1:A5").Name = Worksheets("Sheet2").Range("A1")

For loop and if statement to copy in another sheet

I am currently trying to check cells from 2 columns (one for loop for each) and see whether they have the string true. If yes I would like to copy some cells corresponding, to another sheet(log).
I know that I have some cells, which contain the word true but when I run the program there is nothing that is copied in my other sheet.
I do not get any compiling errors and would like to know where I am wrong in this code.
Sub isLimit()
Dim a As Long, b As Long, Lr As Long
x = 2
y = 2
Lr = Worksheets("Targets").Cells(Rows.Count, "A").End(xlUp).Row
For i = 8 To Lr
If (StrComp(Cells(i, 15).Text, "TRUE")) = 0 Then
Worksheets("Log").Range("B" & x) = "no"
x = x + 1
End If
Next i
For j = 8 To Lr
If (StrComp(Cells(j, 16).Text, "TRUE")) = 0 Then
Worksheets("Log").Range("B2") = Worksheets("Targets").Range("B1").Value
Worksheets("Log").Range("C" & y) = "yes"
y = y + 1
End If
Next j
End Sub
So far, I can see two problems that might causing you the trouble.
1.Since you are not setting which sheets to be checked from line below,
It will check for the activesheet cells i,15 then return -1 or 0 (true or false).
Which will only work when your screen displays sheet where data is stored.
If (StrComp(Cells(i, 15).Text, "TRUE")) = 0 Then
2.If your DATA contains something else then TRUE (for example space before or after the value).
It might see it as something other than "TRUE"
That's all I can tell without looking at your actual data.

Vba - Rows Property

I am a novice of Vba.
I have been litteraly fighting all day with this bit of code:
Sub ComandsCompactVisualization()
Dim x, i As Integer
Dim CellToAnalyse As Range
x = 2
i = 0
For i = 0 To 5 Step 1
Set CellToAnalyse = Worksheets("Comandi").Cells(x + i, 2)
If Not CellToAnalyse.Font.ColorIndex = 2 Then
Worksheets("Comandi").Rows("x+i:2").Hidden = True
End If
Next i
End Sub
I am trying to hide all the rows that in cell (x+i,2) have not got red text.
I am almost there but... Rows does not seem to accept as content Rows("x+i:2").
I obtain Runtime error 13 "Type mismatch".
If I substitute its content with Rows("2:2") row 2 is deleted but I am not any more able to hide all the other rows that do not have red text in column 2.
Ideas?
Anything between quotes "like this" is just a string. To perform arithmetic on x you need to do this first, then concatenate it to the other part of the string. Like this:
.Rows((x + i) & ":2")
BTW Isn't red 3..?
Sub ComandsCompactVisualization()
Dim x as long, i As Long 'You must declare ALL variables (x was as variant in your code)
Dim CellToAnalyse As Range
dim WS as Worksheet
'x = 2 'if x is always the same value, no need to calculate it each loop
'i = 0 'numbers are initialized to be 0, strings to be "", boolean to be false.
set WS=Sheets("Commandi")
For i = 0 To 5 ' Step 1
Set CellToAnalyse = WS.Cells(2 + i, 2)
If CellToAnalyse.Font.ColorIndex <> 2 Then
CellToAnalyse.entirerow.hidden=true
' WS.Rows(2+i).entirerow.hidden = true is the same result
End If
Next i
End Sub

Check if any rows are duplicate and highlight

I have data in (Sheet4) columns A to I:
I'm trying to compare data for all rows (Only on column A and B) to see if any of the rows is duplicated, if it is: excel should highlight both rows.
Example:
A B C......I
s 1 x
s 3 w
e 5 q
s 1 o
Row 1 and 4 should be highlighted as values are the same for column A and B.
I shouldn't modify the sheet (no modification to the columns or rows should be done to the sheet), and the number of rows is not always known (not the same for all files).
Is there an easy way (using macros) to do this???
This is an attempt I have tried, but it is increasing my file to 7MB!!!!! I'm sure there should be an easier way to compare rows for an unknown number of rows and just highlight the dupllicates if they exist:
Public Sub duplicate()
Dim errorsCount As Integer
Dim lastrow As Integer
Dim lastrow10 As Integer
errorsCount = 0
lastrow = Sheet4.Cells(Rows.Count, "A").End(xlUp).Row 'is the row number of the last non-blank cell in the specified column
lastrow10 = lastrow
Sheet10.Range("B1:B" & lastrow10).Value = Sheet4.Range("A1:A" & lastrow).Value
Set compareRange = Sheet10.Range(column + "2:" & Sheet10.Range(column + "2").End(xlDown).Address)
For Each a In Sheet10.Range(column + "2:" & Sheet10.Range(column + "2").End(xlDown).Address)
c = a.Value
If c <> Null Or c <> "" Then
If name = "testing" Then
If WorksheetFunction.CountIf(compareRange, c) > 1 Then
a.Interior.ColorIndex = 3
errorsCount = errorsCount + 1
End If
End If
End If
Next a
If errorsCount > 0 Then
MsgBox "Found " + CStr(errorsCount) + " errors"
Else
MsgBox " No errors found."
End If
End Sub
Silly answer to you.
J1 or just duplicate sheet.
J1 =CONCATENATE(A1,"#",B1) > drag down > J:J > conditional format > highlight cells rules > duplicate values.
(* replace the # to any string which you think not possible in the original A:A and B:B.)
I do this all the time.
To collect all duplicates just SORT with color.

Resources