I have the following code that I've written to take some names and use them to populate a timesheet.
Sub InitNames()
Dim i As Integer
i = 0
Dim name As String
Windows("Employee Data.xlsx").Activate
Sheets("Employees").Select
Range("A2").Select
Do Until IsEmpty(ActiveCell)
name = ActiveCell.Value
Workbooks("Timesheet").Sheets("ST").Range("A9").Offset(i * 9).Value = name
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Basically, the cells in the target sheet are spaced 9 rows away from each other, so the first name would go in cell A9, the second in A18, the third in A27, and so on. I'm sure I'm missing something incredibly simple, but I'm not getting any feedback from Excel whatsoever (no error messages). The cells in the timesheet are merged cells, but I cannot change them (locked by the owner), but I don't think that has anything to do with it.
EDIT: I added a line: OriginalValue = Workbooks("Timesheet").Sheets("ST").Range("A10").Offset((x - 2) * 9, 0).Value so I could watch to see what values were being overwritten in my Timesheet and I noticed something interesting: OriginalValue only grabs the first cell's text (A9), thereafter, for every cell (A18, A27, etc.) the debugger indicates that OriginalValue = "" even though those cells also contain names. However, when I open another worksheet and reference A9, A18, etc., I AM pulling the names.
EDIT 2: I modified the test line to read Workbooks("Timesheet").Sheets("ST").Range("A" & ((x - 1) * 9)).Value = "Test" which does change the values in all the target cells. Why would VBA allow me to assign "Test" to a cell value but not the names in the other worksheet?
Try something like this. It will accomplish the task you are requesting without using .Select or .Activate
Sub InitNames()
Dim i As Integer
Dim Wksht as Worksheet
i = 0
Set Wksht = Workbooks("Employee Data.xlsx").Sheets("Employees")
For i = 2 to Wksht.Range("A" & Wksht.Rows.Count).End(xlUp).Row
Workbooks("Timesheet").Sheets("ST").Range("A9").Offset((i-2) * 9,0).Value = Wksht.Range("A" & i).Value
Next i
End Sub
Related
We currently have a spreadsheet that is used for scheduling, the gentleman using it doesn't want it changed so what I was thinking was create a new sheet with different formatting using VBA or a macro or?? I will then be able to import the new sheet into access where it is needed for a different program. I am attaching 2 different pictures the first is what it looks like now and 2nd is what I would like it to look like.
Old format
Better picture of Old Format
New format
. I have not done a lot of coding in Excel, normally just ='Sheet1'!E5, but didn't see how I could move the date properly and then not have the date show up any where else. The schedule may have 1 item assigned for a day or multiple items. If I have left something out that would be helpful please let me know.
If I understand you correctly...
The old format is something like this :
The expected result for the new format :
If that's what you mean...
Sub test()
Dim rg As Range: Dim cell As Range
Dim rgCnt As Range: Dim cnt As Long
Sheets("Sheet1").Copy Before:=Sheets(1)
With ActiveSheet
.Name = "TEST"
.Columns(1).Insert
.Range("A1").Value = "DATE"
Set rg = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
End With
For Each cell In rg.SpecialCells(xlCellTypeBlanks)
Set rgCnt = Range(cell.Offset(1, 0), cell.Offset(1, 0).End(xlDown))
If cell.Offset(2, 0).Value = "" Then cnt = 1 Else cnt = rgCnt.Rows.Count
cell.Offset(1, -2).Resize(cnt, 1).Value = cell.Offset(0, 1).Value
Next
rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
There is a consistent pattern in the old format, where to the right of each blank cell in column B is the date. So we use the blank cell in column B as the benchmark to get the date in column C.
The process:
it copy sheet1 where the old format is.
name the copied sheet to "TEST"
insert one column, and put the header name "DATE"
since HD-2 now is in column C (after insert one column)
so the code make a rg variable to data range in column C.
Then it loop to only the blank cell in rg
set the range to check how many data under each date into rgCnt variable
if the looped cell offset(2,0) is blank then there is only one data under the date so it make the value of cnt variable = 1
if the looped cell offset(2,0) is not blank then there is more than one data under the date, then have the value of cnt from the rgCnt rows count.
then it fill column A (DATE header) with the date as many rows defined by the cnt value.
After the loop done, it delete the entire row of all blank cell in rg variable.
I am trying to create a macro that will first allow the user to easily transfer data to another sheet based on a dropdown list to select the month. I want the user to able to enter the date in the field I have created, then use buttons on the sheet to first select which month to paste though, then confirm the paste. I have twelve named ranges from Ref_Jan to Ref_Dec on a sheet named "DB - Ref Monthly" I am working on putting together the pieces but I'm stuck here with my test program:
Sub Button8_Click()
Dim MonthSelector As Range
Dim Ref_May As Range
If Range("MonthSelector") = Range("Ref_May") Then
Sheets("DB - Ref Current").Range("Ref_Current").Copy
Sheets("DB - Ref Monthly").Range("Ref_May").PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
Else
End If
End Sub
My current plan is to use 12 if statements to refer to each month, as I already have the copy/paste portion of the code working in another sheet. If I am going about this all wrong I would not mind some guidance. Please let me know if I have been unclear and can provide additional information.
Use looping to iterate months then no need to duplicate a code logic.
Dim arrMonth As New Collection
Dim idx As Integer
Dim val As String
Call arrMonth.Add("Jan")
Call arrMonth.Add("Feb")
Call arrMonth.Add("Mar")
'..etc..
Call arrMonth.Add("Dec")
For idx = 1 To arrMonth.Count
val = arrMonth.Item(idx)
Call MsgBox(idx & "=" & val)
Next
Assuming Range("MonthSelector") is a cell that has a value from a list of months (Jan, Feb, Mar, etc.), and you've got corresponding named ranges Ref_Jan, Ref_Feb, Ref_Mar, etc., you could just do this:
Sub Button8_Click()
Sheets("DB - Ref Current").Range("Ref_Current").Copy
Sheets("DB - Ref Monthly").Range("Ref_" & Range("MonthSelector").Value).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I have multiple spreadsheets that I need to copy column starting at "S4", on a specifically named worksheet, and I need only the cells in that column (starting at S4 and everything below it) that contain data.
I need to copy that data and paste it into my "main" spreadsheet starting at A2 on a specific worksheet. I can do this with one spreadsheet, but the problem I'm running into I need VBA to find the last cell in column A that has a value and start pasting new data into the cell below it, etc... Otherwise, when it's looking at the other spreadsheets, it's just overwriting the data in my main spreadsheet.
You'll notice the specified range of S4:S2000 - its purpose was for a single spreadsheet, which worked fine because I never had data past 2000, but I really just need it looking for cell values and grabbing those.
This is the chunk of code where I'm having the trouble. I want it to search starting at A2 (skipping the column header), look for the last cell that has a value and paste cells with values starting at S4 on the other worksheet.
On Error Resume Next
Set wbkCS = Workbooks.Open(strCutSheetFile(i))
On Error GoTo 0
If Not wbkCS Is Nothing Then
With wbkVer.Sheets("Cutsheets")
.Range(.Cells(2,1)).End(xlUp).Row = wbkCS.Worksheets("Cut Sheet").Range("S4:S2000").Value
I had to tweak yours a little because I'm working with protected files, but this worked:
Set copyRng1 = Worksheets("Cutsheets").Range("A2")
If copyRng1 = "" Then
wbkCS.Worksheets("Cut Sheet").Range("S4:S2000").Locked = False
wbkCS.Worksheets("Cut Sheet").Range("S4:S2000").Copy Destination:=wbkVer.Worksheets("Cutsheets").Range("A2")
Else
wbkCS.Worksheets("Cut Sheet").Range("S4:S2000").Copy Destination:=wbkVer.Worksheets("Cutsheets").Range("A" & wbkVer.Worksheets("Cutsheets").Range("A65536").End(xlUp).Row + 1)
End If
Here's an example that may push you in the right direction...
Suppose I want to aggregate my data in Sheet1 using data from S4:S2000 in all other worksheets in the workbook.
Sub CopyAndStack()
Dim wkShtIndex As Integer, copyRng As Range
Set copyRng = Worksheets(1).Range("A2")
For wkShtIndex = 2 To Worksheets.Count
If copyRng = "" Then
Worksheets(wkShtIndex).Range("S4:S2000").Copy Destination:=copyRng
Else
Worksheets(wkShtIndex).Range("S4:S2000").Copy Destination:=Range("A" & copyRng.End(xlDown).Row + 1)
End If
Next wkShtIndex
End Sub
I check if A2 is empty and if so I paste the first lot of data.
If A2 is not empty I get the next empty cell in column A and paste it there.
Here's how you can get exactly the rows that are populated in S:
Dim StrRange As String
. . .
'Get range
strRange = "S4:S" & Worksheets(wkShtIndex).UsedRange.Columns("S:S").Rows.Count
'Do something with range
Worksheets(wkShtIndex).Range(strRange)
I have a pivot table in an Excel worksheet that contains the result of a query made to my database. I would like to format the information automatically based on every other data set.
The information contains 4 weeks' (1 month) worth of records for each employee sorted by an employee ID number. I would like to write a module so that it will highlight every other record (employee data set) with a different color. Is this even possible to do? Thanks for the help!
If you insist with solving your problem utilizing VBA here is an example. You'll need to specify start ranges. Please not that marking whole row will use more memory (increasing file size) so I would rather use example: range("A2:E2).select ....
Sub FormatEverySecondRow()
range("A2").EntireRow.Select
Do While ActiveCell.value <> ""
Selection.Interior.ColorIndex = 15
ActiveCell.offset(2, 0).EntireRow.Select
Loop
End Sub
use a helper column (K if I count the columns in your example)
insert into K2:
=IF(ISBlank(C2),K1,MOD(K1+1,2))
then use conditional formatting to highlight the row:
Note the formula does not have a $ sign before the 2 (i.e. $K2, not $K$2)
This might be useful to you:
Sub HighlightDifferentRows()
Dim wksht As Worksheet
Dim wkb As Workbook
Dim row As Range
Dim FloatColor As Long
FloatColor = RGB(100, 100, 100)
Set wbk = ThisWorkbook
Application.ScreenUpdating = False
For Each row In Sheets(1).UsedRange.Rows
row.Interior.Color = FloatColor
If row.Cells(1, 4).Value <> row.Cells(2, 4).Value Then
FloatColor = -FloatColor
End If
Next row
Application.ScreenUpdating = True
End Sub
It alternates row colors whenever a cell value is not the same as the one below it. Right now it is set to grayish colors but you could change it to something brighter if you wanted. You could put in your own logic to get whatever colors you wanted. Good Luck.
I've written a macro in VBA that simply fills in a given cell's value from another cell in that sheet. I do this for lots of cells in the sheet, and I'm doing it like so:
Range("B3").Value = Range("B200")
Range("B4").Value = Range("B201")
'etc.
Now, I am often adding values by inserting new rows, so I might insert a new row
between B200 and B201, which will break the macro because it doesn't autoupdate when
I insert the new row.
How can I code the macro so it autoupdates the cell references when I insert new rows or columns?
My suggestion would be to make sure the ROW you want to retrieve values from has a unique value in it that you can .FIND anytime you want, then grab your values from column B of that found cell's row. So right now you want to get a value in B200 and A200 always has the text in it: "Final Total" and that is unique.
Dim MyRNG As Range
Set MyRNG = Range("A:A").Find("Final Total", LookIn:=xlValues, LookAt:=xlWhole)
Range("B3").Value = Range("B" & MyRNG.Row)
Range("B4").Value = Range("B" & MyRNG.Row + 1)
This is not an answer but an alternative.
Naming your range is the way to go as Shiin suggested but then if you have 500 cells then like I mentioned earlier, naming 500 cells and using them in your code can be very painful. The alternative is to use smart code. Let's take an example
Let's say you have a code like this
Sub Sample()
Range("B3").Value = Range("B200")
Range("B4").Value = Range("B201")
Range("B5").Value = Range("B201")
' And
' So On
' till
Range("B500").Value = Range("B697")
End Sub
The best way to write this code is like this
Sub Sample()
Dim i As Long
For i = 200 To 697
Range("B" & i - 197).Value = Range("B" & i)
Next i
End Sub
and say if you insert a line at say row 300 then simply break the above code in two parts
Sub Sample()
Dim i As Long
For i = 200 To 299
Range("B" & i - 197).Value = Range("B" & i)
Next i
For i = 301 To 698
Range("B" & i - 197).Value = Range("B" & i)
Next i
End Sub
So every time you insert a row, simply break the for loop into an extra part. This looks tedious but is much better than naming 500 cells and using them in your code.
If you are planning to use the macro only once (i.e for 1 time use) then read ahead.
If you are worried that when the user inserts the row then the cells are not updated then you can instead of assigning a value, assign a formula.
For example
Range("B3").Formula = "=B200"
This will put a formula =B200 in cell B3. So next time when you insert a row so that the 200th row moves it's position, you will notice that the formula automatically gets updated in cell B3
HTH
Try giving a name to the range. If you refer to the range by name Excel searches for it and retrieves the rows that defines it. Range names update their definition when new rows are added.
Adding to the above, i think this tutorial illustrates my point:
http://www.homeandlearn.co.uk/excel2007/excel2007s7p6.html this is how to define the name of the range.
This tutorial explains how to use it on macros and vba:
http://excel.tips.net/T003106_Using_Named_Ranges_in_a_Macro.html
I hope this helps :D