I need some help with some VBA. The code below sorts a bunch of data which is spread horrizonally then apends them vertically which I have posted below:
Sub Test()
Application.ScreenUpdating = False
countrow = ActiveSheet.UsedRange.Rows.Count
countcolumn = ActiveSheet.UsedRange.Columns.Count
numberofiterations = countcolumn / 6
MsgBox "Number of Rows is" & Str(countrow)
MsgBox "Number of Column is" & Str(countcolumn)
ActiveSheet.Select
a = 1
b = 1
c = 6
d = 1
While n < numberofiterations
Range(Cells(a, b), Cells(countrow, c)).Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Cells(d, 1).Select
Sheets(2).Paste
Sheets(1).Select
b = b + 6
c = c + 6
d = d + countrow
n = n + 1
Wend
End Sub
It runs ok once but when running it for the second time it itteraits through to the line:
While n < numberofiterations
I can't find the reason why it drops out the loop the second time. Any help will be apriciated
Thanks,
A few things to consider:
1) Please initialize the value of n. That is, before you start your loop, set
n = 0
explicitly. If you later add other code that happens to set n to some value, you will not get the result you expect
2) When you say
countrow = ActiveSheet.UsedRange.Rows.Count
Range(Cells(a, b), Cells(countrow, c)).Select
You will not get a selection all the way to the bottom of the range IF THE USED RANGE DIDN'T START IN ROW 1. If UsedRange = $Q1:Z20, then UsedRange.Rows.Count = 10, not 26!
This second point is probably not your problem today - but I wanted to point it out as it will bite you another time.
3) I am a huge fan of writing
Option Explicit
at the top of every module. It forces you to be thoughtful about every variable you create, and more likely will make you remember to initialize variables as well. In general it's good practice, and should be right up there on your list with "initialize right before you use".
Related
I have two tables. One table is called DRData (Blad3), other table is CheckData (Blad2). EANCODE is Column J for DRData, and Column A for Checkdata.
I want to check whether CheckData.EANCODE is present in DRData.EANCODE. If so; delete that row from CheckData.
I tried several things, but no success yet. The code I have written now is as follows:
Sub FindEAN()
Dim i As Long
Dim x As Long
x = 1 'Start on first row
EANtoFind = Blad2.Range("A" & x).Value
For i = 1 To 99999 '
If Blad3.Cells(i, 1).Value = EANtoFind Then
Blad2.Range("A" & x).EntireRow.Delete
Else: x = x + 1
End If
Next i
End Sub
When the EANCODE is not present, I want to hop over a row to check that code. I want to end with a list in CheckData where all the EANCODE values that are not in DRData are shown.
With the code above, only the first row is getting deleted and now I'm stuck how to get this to loop. Including the x+1 to get to the next row.
First you have to clarify that your problem is a little bit complicated. You have to pay attention to indexes when deleting rows
To do that, you have to point the the maximal number of line to optimize your loop
A simple way to do that, is to use predefined search function, and edit your code a little bit.
My favorite is Application.match(), which takes 3 parameters :
Value to look for
Array where you look (in our case the column J of Blad3 or position 10)
0 : exact match
For more details, see the documentation
https://learn.microsoft.com/fr-fr/office/vba/api/excel.worksheetfunction.match
An example of code which works is like the following
Sub FindEAN()
Dim x As Long
x = 1 'Start on first row
maxline = Blad2.Range("A" & Rows.count).End(xlUp).row
While x <= maxline '
EANtoFind = Blad2.Range("A" & x).Value
If Not IsError(Application.Match(EANtoFind, Blad3.Columns(10), 0)) Then
Blad2.Range("A" & x).EntireRow.Delete
maxline = maxline - 1
Else
x = x + 1
End If
Wend
End Sub
I ran into a problem when I try to add the first 10 even numbers in a column regardless of the number of inputs someone has entered into said column.
The issue occurs when there are less than 10 inputs (in my case 7) and I have tried to break the loop if there are no more numbers after the last one but it doesn't seem to work as it crashes Excel; most probably because it loops infinitely.
The original code was fine until I entered below 10 even numbers. When I did it would loop infinitely and crash so I inputted a forceful break in the code (hence the Count=999) but it does not seem to work
Sub TenPosInt()
Dim Total As Integer, size As Integer, myRange As range
Dim Count As Integer
Count = 1
Set myRange = range("W:W")
size = WorksheetFunction.CountA(myRange)
While Count <= 10
If IsEmpty(Cells(Count, "W")) Then
Count = 999
End If
If Cells(Count, "W").Value Mod 2 = 0 Then
Total = Total + Cells(Count, "W").Value
Count = Count + 1
End If
Wend
MsgBox Total
End Sub
My Inputs are currently 2,4,6,5,2,4,6,8,1,3,5 so it does not meet the 10 even integers, however I still want it to run regardless (hence the Count=999 line). The correct return should be 32.
A Do-While/Until loop is recommended instead of While-Wend (see this).*
Here I use a separate counter for row and the number of even values (and stole David's idea of combining the two conditions in the Do line).
Sub TenPosInt()
Dim Total As Long, r As Long, Count As Long
r = 1
Do Until Count = 10 Or Cells(r, "W") = vbNullString
If Cells(r, "W").Value Mod 2 = 0 Then
Total = Total + Cells(r, "W").Value
Count = Count + 1
End If
r = r + 1
Loop
MsgBox Total & " (" & Count & " even numbers)"
End Sub
*Actually I would be more inclined to use one of the other gent's answers, but I have tried to stick as close to yours as possible. (Also a good idea to check a cell is numeric before checking for even-ness.)
Just for fun - here is an approach that uses a For...Next loop, allows for non-numeric entries in Column W, and handles the possibility of blank rows between entries.
Sub TenPosInt()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "W").End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
If Not IsEmpty(Cells(i, "W")) Then
If IsNumeric(Cells(i, "W")) Then
If Cells(i, "W").Value Mod 2 = 0 Then
Dim counter As Long
counter = counter + 1
Dim total As Long
total = total + Cells(i, "W").Value
If counter = 10 Then Exit For
End If
End If
End If
Next
MsgBox total
End Sub
Why not use a standard for loop across a range? this would give more specific inputs for the subroutine.
Description of what is occuring below has been commented out to allow for copy/pasting more easily.
'Define your range (you use columns("W"), but narrow that)... assuming you start in row 2 (assumes row 1 is headers), move to the last row, of the same columns:
lr = cells(rows.count,"W").end(xlup).row
'so you know the last row, loop through the rows:
for i = 2 to lr
'Now you will be doing your assessment for each cell in column "W"
if isnumeric(cells(i,"W").value) AND cells(i,"W").value mod 2 = 0 then
s = s + cells(i,"W").value
counter = counter + 1
if counter = 10 then exit for
end if
'Do that for each i, so close the loop
next i
'You now have determined a total of 10 items in the range and have added your items. Print it:
debug.print s
Edit1: got a comment to not break-up the code in an explanatory fashion, so I have added ' to comment out my explanations in an effort to make my coding portion copy/pasteable as a lump.
I have more than 20 hidden columns with data. I want 4 columns to appear and then the next 4 columns on each click of a button.
I tried the below code. Instead of 4 columns at a time, it shows all 20 columns in a click.
Sub compare() '
'compare macro
'selects the button1 rows for the output tab
application.screenupdating=true
range("I10:AR62").entirecolumn/hidden=false
range("B1").select
application.screenupdating=false
End
you want something like:
range(columns(j),columns(j+k)).entirecolumn.hidden=true
range(columns(y),columns(y+z)).entirecolumn.hidden=false
but you need logic to determine what j is... first scenario is where nothing is hidden:
if not columns(9).entirecolumn.hidden and not columns(13).entirecolumn.hidden and not columns(17).entirecolumn.hidden and not columns(21).entirecolumn.hidden then
Then you will want to hide such that:
j = 13
k = 15
Where that scenario is not true (ELSE), you should have some logic embedded to determine what is hidden and unhide other sections:
if not columns(9).entirecolumn.hidden then
j = 9
k = 3
y = 13
z = 3
You would need the above for each of your column groupings to tell what isn't hidden, so you know what grouping is next.
You would have listed what sections will be visible and which sections would be hidden based on the column numbers.
I know it has been a few days since anyone has posted on this, but I figured I would post this part of a macro that I have built for another project. This should work as intended, and the variables are already setup according to the OP's question.
Sub DynHideColumns()
FirstColumn = 9 ' First Column that could be hidden
LastColumn = 200 ' Last Column that could be hidden
ColumnSteps = 4 ' Number of columns to hide per start
x = FirstColumn
Z = 1
ReDim y(1 To ColumnSteps)
Do Until x > LastColumn
If ActiveSheet.Range(Columns(x), Columns(x)).EntireColumn.Hidden = False Then
If Z <= ColumnSteps Then
y(Z) = x
Z = Z + 1
Else
y(1) = ""
End If
End If
x = x + 1
Loop
ActiveSheet.Range(Columns(FirstColumn), Columns(LastColumn)).EntireColumn.Hidden = True
If y(1) = "" Then
ActiveSheet.Range(Columns(FirstColumn), Columns(FirstColumn + ColumnSteps - 1)).EntireColumn.Hidden = False
Else
If y(ColumnSteps) = LastColumn Then
ActiveSheet.Range(Columns(FirstColumn), Columns(FirstColumn + ColumnSteps)).EntireColumn.Hidden = False
Else
ActiveSheet.Range(Columns(y(1) + ColumnSteps), Columns(y(ColumnSteps) + ColumnSteps)).EntireColumn.Hidden = False
End If
End If
End Sub
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.
The program I am working on involves reading and determining the difference between i - (i+1) and i-(i-1) from excel.
If the difference exceeds 4 then the program deletes the row at i.
The program works well at the first try. Suddenly, it says that "You can not change part of an Array".
Option Explicit
Sub Data_Delet()
Dim a As Double, b As Double, c As Double, i As Double
Dim rkill As Range
' a,b, and c are used as steps in order to proceed to the next data points
a = 18
b = 0
c = 0
With ThisWorkbook.Worksheets("Sheet1")
' The second do loop delete data points that does not follow the requirements
Do
If Abs(.Cells(a - 1, 2) - .Cells(a, 2)) > 4 And Abs(.Cells(a, 2) - .Cells(a + 1, 2)) > 4 Then
If rkill Is Nothing Then
Set rkill = Rows(a)
Else
Set rkill = Union(rkill, Rows(a))
End If
End If
a = a + 1
Loop Until .Cells(a, 2).Value = ""
If Not rkill Is Nothing Then rkill.EntireRow.Delete
' The third Do loop determines the number of data points that are still present after deleting the data points
Do
i = .Cells(17 + c, 1)
c = c + 1
Loop Until .Cells(17 + c, 1).Value = ""
' The if statment determine whether or not the number data points from before are the same after deletion process
If b = c Then
.Cells(2, 5) = "N"
Else
.Cells(2, 5) = "Y"
End If
' c is the number of data point after deletion
.Cells(12, 5) = c
End With
End Sub
The error "You cannot change part of an array" on rkill.EntireRow.Delete means that the row you want to delete is intersecting a range referenced in an array formula (a formula with braces).
Excel does not allow this. One way would be to remove the offending array formula(s) at the start of your code, and redefine it/them again at the end of your code. Or find a solution to turn these array formulas into normal formulas.