I have been doing some basic VBA programming in Excel 2010 but I have been struggling with this challenge for some time. Basically, I have a sheet that is formatted like this (It actually has 62 columns and rows=# of days in the given month):
Column A will be hidden but is used in a few formulas.
Row 15 shows whether or not the station is open 24/7(all) or only Monday-Friday(M-F).
the values presented are arbitrary counts. However, a blank count represents a problem unless... the station is M-F and
I need to get my code to identify a station that is open M-F and then fill in any particular Sat. or Sun (for that station) with the word "closed." then search for the next station that is M-F and repeat the process.
Initially I was having my code start with an actual value and then use several activecell.offset functions to find empty cells and then check conditions but I couldn't get it to work out. Then I tried to check from the station name or the schedule row but I couldn't get the multiple if/nested offset statements to work either.
I would really appreciate any help or insight you could provide that would show me the best approach. I don't really need the code that does it I just need a pseudo code walk-through unless you are kind enough to write out the code.
Thanks for your help!
I had a similar problem I worked out before. I modified it to your spreadsheet:
Dim d As Long, s As Long
d = 1 'weekdays column
s = 40 'status row
Dim r As Long, c As Long
r = ActiveSheet.Cells(Rows.Count, d).End(xlUp).Row
c = ActiveSheet.Cells(s, Columns.Count).End(xlToLeft).Column
Dim i As Long, cell As Range
i = 0
Dim days() As Long
For Each cell In Range(Cells(1, d), Cells(r, d))
If cell.Value = "Sat" Or cell.Value = "Sun" Then
ReDim Preserve days(i)
days(i) = cell.Row
i = i + 1
End If
Next cell
For Each cell In Range(Cells(s, 1), Cells(s, c))
If cell.Value = "M-F" Then
For i = LBound(days) To UBound(days)
Cells(days(i), cell.Column).Value = "closed"
Next i
End If
Next cell
Related
I work for a local company that uses antiquated systems relying on much manual data entry. Trying to ease the pain with some faster capabilities using excel vba and formulas. I've built a spreadsheet filled with formulas and vba buttons. I'm literally on the last part and have been stuck now for at least 2 weeks. Time is now running out and I'm hoping for some assistance.
Spreadsheet has 2 sheets named "Sheet1" and "Sheet2". On Sheet1 I use a button to concatenate and move data into one cell which is L11. In L8 I have a constant changing date, day by day. The data entry works like this: I enter data for April 11th and then change the date in L8 to April 14th (could be any day, just using 14 as an example) to enter the next set of data. On Sheet2 I have each column labeled by days in the month, i.e. Column A = 1-Apr, Column B = 2-Apr, Column C = 3-Apr, etc.... to the end of the month 30 or 31 which equals Column AD or AE.
What I'd like for the code to do is move the data from cell L11 on sheet1, based on the date in L8 on sheet1, the data moves from sheet1 to sheet2 under the corresponding date. So the click of a button, the macro/vba code finds the date on sheet2 and looks for the date in L8 sheet1 and says:
"I see a date of 17-Apr in L8, what data exists in cell L11 on sheet1? Ahhh ok.. there is data in L11 sheet1. I will go ahead and take that data from L11 and paste it in column 17(column Q) in the next available slot below. Then I will make sure the data is removed from Sheet1 and put the user back on Sheet1 ready to be used again."
Please keep in mind that the data that exists in L8 sheet1 (the date) contains a vlookup formula. If that is not needed, I'll gladly take other ideas on matching dates. Or for that matter any other ideas that are better than what you see above and below I'm always open to suggestions. Also, the button I use to concatenate data that ultimately ends up in cell L11 sheet1 is a recorded macro. Basically I recorded copying specific cells and pasting them together in one cell and then inserted a single cell that pushes the concatenated data down one cell so that I could enter more than one set of data.
This is the most recent code I've been working on. When I used the loops for i and j, the code did not error out, however it didn't do anything when running. I recently tried adding k and m, but the wall I'm hitting just won't budge. Help please...
Sub senddatatosheet2()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim mydate As String
lastrow1 = Sheets("sheet1").Range("L" & Rows.Count).End(xlUp).Row
For i = 8 To 8
For k = 11 To 11
mydate = Sheets("sheet1").Cells(i, "L").Value
Sheets("Sheet2").Activate
lastrow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To lastrow2
For m = 2 To lastrow2
If Sheets("sheet2").Range(Cells(j, "A")).Value = mydate Then
Sheets("Sheet1").Activate
Sheets("Sheet1").Range(Cells(11, "L")).Copy
Sheets("Sheet2").Activate
Sheets("Sheet2").Range(Cells(j, "A"), Cells(j, "AD")).Select
ActiveSheet.Paste
End If
Next j
Next m
Application.CutCopyMode = False
Next i
Next k
Sheets("Sheet1").Activate
Sheets("sheet1").Range("A1").Select
End Sub
Correct me if I'm wrong...
You enter the date in Sheet1!L8, then enter whatever data you want into whatever cells you do, which is all concatenated into Sheet1!L11.
You want to transfer the data in Sheet1!L11 into say Sheet1!xy (where x=the column for the data to go into for that day and y=the next empty row), who's date is in Sheet1!x1 and it matches the date in Sheet1!L8
If so, the following should do:
Sub btnNext_Click()
Dim MyDate As Date
Dim ColFound As Long, NextRowToUse As Long, MyData As String
Dim RowThatContainsDates As Long
'Enter the row that contains the dates across the top
RowThatContainsDates = 1
'Get the date from Sheet1!L8
MyDate = Sheets("sheet1").Cells(8, 12).Value
'Get the data from Sheet1!L11
MyData = Worksheets("Sheet1").Cells(11, 12).Value
'Get the column where the date in Sheet1!L8 is found
ColFound = Worksheets("sheet2").Rows(RowThatContainsDates).Find(MyDate, LookIn:=xlFormulas, LookAt:=xlWhole).Column
'Get the next row to use for the selected Column
NextRowToUse = 1
Do While Worksheets("sheet2").Cells(NextRowToUse, ColFound).Value <> ""
NextRowToUse = NextRowToUse + 1
Loop
'Duplicate the text from Sheet1!l1 to the Row and Column found
Worksheets("Sheet2").Cells(NextRowToUse, ColFound).Value = MyData
'Clear the contents of the cells containing the original data
Worksheets("Sheet1").Range("L3:L6").ClearContents
End Sub
I have what I thought was a very basic VBA challenge, and have spent hours searching for an answer. Thanks if someone can point me to the right place if already addressed.
I have a formula that is B1 + C1 = D1, and have two 1x5 matrix of data inputs, one for cell B1 and one for cell C1, say [1,2,3,4,5] and [A,B,C,D,E], respectively, in cells (B2:B7) and (C2:C7). I would like to loop through the inputs, such that I get five unique answers [1+A, 2+B, 3+C, 4+D, 5+E], and output those answers in an adjacent 1x5 matrix, say in cells (D2:D7).
Recording a macro does not work here, as it records a copy/paste action that is inflexible for future use (for expanded matrices, other sheet locations, more complex formulas, etc).
Any help much appreciated.
Henry
UPDATE: I believe I need to be using "Do While" or some similar loop code, and additional "For" and "Next" coding.
UPDATE: Here is a step-by-step picture of what I am trying to do with the code:
step-by-step process results image
Here's the solution code:
Sub IterationMacro()
'Declare Variables
Dim h, i, j, k As Integer
Dim mySheet As Worksheet
Dim myAnswer As String
'Set Worksheet
Set mySheet = ActiveSheet
'Set # of Iterations
h = Range("B2").Value
'Clear Previous Contents
Range("C4:D4").ClearContents
Range("e5:e11").ClearContents
'Run Through Loops
For i = 5 To h + 4
For j = 3 To 4
mySheet.Cells(4, j).Value = mySheet.Cells(i, j).Value
Next
'Calculate Workbook
Calculate
mySheet.Cells(i, 5).Value = mySheet.Cells(4, 5).Value
Next
End Sub
If you could draw a table or something to use as an example, it might help.
Assuming I'm undersatnding you, you want to use a formula in D1, and fill down to D7, resulting in showing B+C=D in each row:
Range("D1").Formula="=B1+C1"
Range("D1:D7").Filldown
Edit:
Having been given the example image, it looks like you want math to happen in Row 2 (headers in Row 1). In Row 2 you want to pull up values from Row "i" and add them in Row 2, then paste the answer of that sum in Row "i".
Dim i as Integer 'i is the variable for the loop
For i = 3 to 9 'based on the picture, 3 to 9 are the 1 through 7 values
Cells(2,1).Value=Cells(i,1).Value 'pulls up Column A value from the loop to Row 2
Cells(2,2).Value=Cells(i,2).Value 'pulls up Column B value from the loop to Row 2
Cells(2,3).Formula="=A2+B2" 'Sums A2 and B2 into C2
Cells(2,3).Copy Cells(i,3) 'Copies the summed value to Row "i" in Column C
Next i 'Moves to next "i" in the loop
Let me know if that is more to your point.
Edit:
With dynamic ranges, you still know your starting point. You would look at something similar to:
Dim i as Integer
Dim LR as Long
Dim LC as Long
LR=Cells(Rows.Count,"A").End(xlUp).Row
LC=Cells(1,Columns.Count).End(xlToLeft).Column
For i = 3 to LR 'Still starting at 3, because of the example
Cells(2,1).Value=Cells(i,1).Value
Cells(2,2).Value=Cells(i,2).Value
Cells(2,LC+1).Formula="=A2+B2" 'Note the LC+1 goes one row BEYOND the last column
Cells(2,3).Copy Cells(i,LC+1)
Next i
In the last example, you can see syntax for dynamic ranges. Note that LR and LC are defined outside of the loop and do not change for the duration of the subroutine.
I have 2 sheets within the same workbook. In worksheet A called "sheet1" and worksheet B called "sheet2". From column A of sheet 1 there are upto 176080 records of duplicate ID numbers. Need to find the unique ID numbers from this column and paste it into column A of sheet 2.
Any help would be appreciated, I am new to VBA macro and found some codes online but do not understand it. Please help me and kindly provide a syntax to solve this with some explanation so I could learn how to do it on my own as well. Thanks!!
May be a little complicated, but this gives back the unique numbers in column "A".
Option Explicit
Dim i, j, count, lastrow As Integer
Dim number As Long
Sub find_unique()
lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For i = 1 To lastrow
number = Cells(i, 1)
For j = 1 To lastrow
If number = Cells(j, 1) Then
count = count + 1
End If
Next j
If count = 1 Then
Cells(i, 5) = number
Else
Cells(i, 5) = ""
End If
count = 0
Next i
End Sub
First the sub takes cell A1 then loops through all other cells, starting at the first, to the last cell in the active Sheet. If a number is equal to more than one cell (it's allways one, because u also check the cell with it's own value) the number will not be displayed in column E. Then it takes the next number and loops through all again until every number is checked. Small changes and the numbers will be shown in the other sheet. Hope it works for you.
I have two columns with random times and the times come from two different sources so the columns do not have the same amount of data points. I want to start with the first time in the first column and compare it to each time in the second column. If there is a match in times, I would like to pull relevant data. After a match is found (if there is one) I would like for the code to go to the second cell in the first column and compare it to every value in the second column and so on.
Here is the code I have so far:
Sub TransferInfo()
'Activate the Sub to Convert and Format Dates
Call ConvertDates
'Define Variables
Dim st As Worksheet
Dim ts As Worksheet
Dim lastrow As Long
Dim i As Integer
j = 2
'Find and set the last used row
Set st = ThisWorkbook.Worksheets("Data Table")
lastrow = st.Cells(st.Rows.Count, "B").End(xlUp).Row
Set ts = ThisWorkbook.Worksheets("ShopFloor")
'Cycle through/compare Row J, Column 18 based on each cell in Row I, Column 14
For i = 2 To lastrow
Do Until IsEmpty(ts.Cells(j, 8)) Or IsEmpty(st.Cells(j, 2))
If st.Cells(i, 14).Value = ts.Cells(j, 18).Value Then
st.Cells(i, 15).Value = ts.Cells(j, 2).Value
Exit Do
Else
st.Cells(i, 15).Value = ""
End If
j = j + 1
Loop
j = 2
Next i
End Sub
The other sub that I call at the beginning of this sub simply rounds the times in each column to the nearest 15 minute interval to increase the likelihood of matches between the columns.
My question is: The code does not copy and paste any more information although there are times that match between the two columns. Why would the code that I have not work? Also, with larger data sets I am afraid that this the code may crash Excel and because I have a loop within a loop trying to process a lot of data a lot of times, but I don't know of a more efficient way to accomplish what I am trying to without this code.
If anyone has any insights as to why this code doesn't work I would greatly appreciate any help.
Thanks!
Based on your code, it looks like you just need an INDEX/MATCH formula. Use this in O2 and copy down:
=IFERROR(INDEX(B:B,MATCH(N2,R:R,0)),"")
No need for VBA
I have an excel file which has column B1 to B500 (may vary) filled with numbers. For example:
I need the output to be like:
I have this much code till now:
Sub Max()
Dim i As Long, j As Long
Dim cl As Excel.Range
i = 1
j = 1
For i = sheet.UsedRange.Rows.Count To 1 Step -1
cl = sheet.Cells(i, 2) '## Examine the cell in Column B
If xl.WorksheetFunction.CountIf(sheet.Range("B:B"), cl.Value) > 1 Then
cl.Value = sheet.Cells(j, 3).value 'copy to Column C
End If
j = j + 1
Next i
End Sub
What this code does is to find duplicates in column B and remove other entries from the column. Nothing gets written in column C. I want the column B to be unedited at the end. Also cannot figure out how to achieve the sorting here.
Please help.
Well, you could use formulas if you want too:
It is very important to use array formulas (Ctrl+Shift+Enter when done editing the cell), my Excel is an Spanish Version, so you just need to change:
- SI by IF
- CONTAR.SI by COUNT.IF
I came up with this solution thinking about the bubble sort algorithm. I hope this will be useful for you.