I am a complete beginner with Excel VBA. I am trying to produce a schedule tracker which has on the "Courses" worksheet all the teaching information of courses running.
Column E uses a formula to identify the cell which cross references the staff member and the course date.
Column K contains the concat (text & Numerical data) statement which I need to have inserted into the correct place on the "Calendar" worksheet (same workbook).
The Code I have so far is shown below:
Private Sub BtnUpdate_Click()
Dim w As Variant
Dim c As Variant
Dim i As Integer
Dim n As Integer
'Application.ScreenUpdating = False
i = 1
w = Sheets("Courses").Range("E" & i).Value
c = Sheets("Courses").Range("K" & i).Value
Do
Sheets("Calendar").Range(w).Select
ActiveCell.Value = c.Value
Loop While n <> Range("E2").End(xlDown).Row
'Application.ScreenUpdating = True
End Sub
Any guidance would be greatly appreciated.
Not too clear .. but you may try this ..
Private Sub BtnUpdate_Click()
Dim w As Variant
Dim c As Variant
Dim i, n As Integer
Dim r as Range
Set r = Range("E65536").End(xlup)
'Application.ScreenUpdating = False
For i = 1 to r.Row
w = Sheets("Courses").Range("E" & i).Value
c = Sheets("Courses").Range("K" & i).Value
Sheets("Calendar").Range(w).Select
ActiveCell.Value = c.Value
'Application.ScreenUpdating = True
Next
End Sub
Related
Very new to this but enjoying the journey.
I am trying to populate a cell then click a button to run the macro. Problem is I have the code all working if I include the cells value in the code.....
Sub CopyRowBasedOnCellValue()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Sheet1").UsedRange.Rows.Count
B = Worksheets("Sheet2").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Sheet1").Range("C1:C" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "ASML" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & B + 1)
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
But I want "ASML" not to be constant. I need it to be variable (ie the value of cell K1)
I am sure it is a simple fix but not very good at this
Bosnia
I am looping through the worksheets to sumif the amounts that are "C" and "D".
Each tabs have the amounts in column M and whether they are credit or debit in column N, indicated by the letter C or D.
First I am putting the letters C and D on blank cells and trying to sumif these two amounts next to them.
I am getting a type mismatch error at the sumif line and the whole line is highlighted.
At first I thought maybe it was ws = Worksheets(I) causing the problem so I swapped them out with Worksheets(I), but it still did not work.
Sub Sumiftabs()
Dim Filepath As String
Dim UIGFile As Workbook
Dim Column As String
Dim Month As String
Dim Year As Integer
Dim I As Long
Dim TY As Integer
Dim TYLetter As String
Dim T As Long
Dim TreatyYear As Long
Dim WS_Count As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False
TreatyYear = Sheets("Control").Range("B7").Value
'On Error Resume Next
For T = TreatyYear To 16 Step -1
TYLetter = WorksheetFunction.VLookup(T, Workbooks("Separate tabs.xlsm").Sheets("Control").Range("H:I"), 2, False)
TY = Sheets("Control").Range("B7").Value
Month = Sheets("Control").Range("B5").Value
Year = Sheets("Control").Range("B4").Value
Filepath = Sheets("Control").Range("B2").Value
Set UIGFile = Workbooks.Open("K:\Ayoon\UIG\" & Year & "\" & Month & "\UIG_NSA_MonYear_TY" & T & ".xls")
WS_Count = UIGFile.Worksheets.Count
For I = WS_Count To 1 Step -1
Set ws = Worksheets(I)
'Direct Premium
UIGFile.Worksheets(I).Range("S4").Value = "C"
UIGFile.Worksheets(I).Range("S5").Value = "D"
UIGFile.Worksheets(I).Range("T4").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), ws.Range("S:S"), ws.Range("M:M"))
UIGFile.Worksheets(I).Range("T5").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), ws.Range("S:S"), ws.Range("M:M"))
Next I
UIGFile.Close savechanges:=True
Next T
Application.ScreenUpdating = True
End Sub
Your SUMIF looks incorrect.
Eg try this instead:
UIGFile.Worksheets(I).Range("T4").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), "C", ws.Range("M:M"))
I am trying to write VBA code to determine which entries in column A do not appear in column B, and then print these entries.
Sub Checker()
Dim endrow As Integer
endrow = 8
For i = 2 To endrow
Next i
End Sub
I think the next step is to use an if statement with the worksheet function match, to first take the "345A" and compare it with each entry in Column B in turn. But haven't any success implementing.
Any help would be appreciated, thanks.
A slow but thorough way:
Sub compareColumns()
Dim r As Range
Dim s As Range
Dim firstCol As Range
Dim secCol As Range
Dim match As Boolean
Set firstCol = Range("A1:A8")
Set secCol = Range("B1:B8")
For Each r In firstCol
match = False
For Each s In secCol
If r.Value = s.Value Then
match = True
Exit For
End If
Next s
Debug.Print r.Address & "has a match = " & match
Next r
End Sub
Option Explicit
Sub Test()
Dim LR As Long, i As Long
LR = 8
For i = 2 To LR
If WorksheetFunction.CountIf(Range("A" & i), Range("B:B")) = 0 Then
Debug.Print Range("A" & i)
End If
Next i
End Sub
First, allow me to thank you for any help you are able to lend me. I appreciate it! (:
My issue is this: I have two workbooks, one with raw data, and one in which the raw data is consolidated into relevant statistics. I am trying to SUMIFS the data in X:X in my raw data workbook (6620) by two criteria in the results book and then update the value in the corresponding cell in the results book.
The problem is that the macro returns all zeros. I have double checked the data types, names, ranges, etc, but no luck. Leaving me to think there is something wonky in my code.
I include two photos at the end of this post of example raw data and results tables so you can see what I am working from.
Sub ImportFTEs()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim ws As Integer
Workbooks.Open Filename:=ActiveWorkbook.Path & "\6620\FY19*.xlsb"
For ws = 1 To Worksheets.Count
Sheets(ws).Name = "Sheet1"
Next ws
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim totalFTE As Long
Dim lastRow As Integer
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
Dim wb_a As Worksheet
Set wb_a = Workbooks.Open(ActiveWorkbook.Path & "\FY19*.xlsb").Sheets("Sheet1")
Dim wb_b As Worksheet
Set wb_b = ThisWorkbook.Sheets("B")
Dim sumRange As Range
Set sumRange = wb_a.Range("X:X")
Dim cRange1 As Range
Set cRange1 = wb_a.Range("D:D")
Dim criteria1 As Range
Dim cRange2 As Range
Set cRange2 = wb_a.Range("S:S")
Dim criteria2 As Range
For k = 8 To 18
For l = 7 To 18
For i = 7 To 18
Set criteria1 = wb_b.Cells(7, i)
For j = 8 To 18
Set criteria2 = wb_b.Cells(j, 6)
wb_b.Cells(k, l).value = Application.WorksheetFunction.SumIfs(sumRange, cRange1, criteria1, cRange2, criteria2)
Next j
Next i
Next l
Next k
ActiveWorkbook.Close savechanges:=True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
You don't need so many nested loops. Your original code is looping through every possible criteria for each k and l. Assuming wb_b.Cells(k, l) is supposed to be a reference to the cell intersected by your month column and employee name row, you could use your i and j values.
For i = 7 To 18
Set Criteria1 = wb_b.Cells(7, i)
For j = 8 To 18
Set Criteria2 = wb_b.Cells(j, 6)
wb_b.Cells(j, i).Value = Application.WorksheetFunction.SumIfs(sumRange, cRange1, Criteria1, cRange2, Criteria2)
Next j
Next i
In column B on three (Bakery, Floral, Grocery) of the five sheets in my workbook, I want to find rows that have the word Flyer in column B. There will be multiple rows in each worksheet that have the word Flyer in column B. When it finds the word Flyer, it will paste the entire row into Sheet1.
I go this to work on one tab, but want the same code to search all three tabs (but NOT all five ... this is the issue) and paste all of the rows with the word Flyer in column B into Sheet1.
My code (works, but only on the Bakery tab):
Sub CopyRowsFlyer()
'This looks in the Bakery tab and moves everything that has "Flyer" in column B to Sheet 1
Dim bottomB As Integer
Dim x As Integer
bottomB = Sheets("Bakery").Range("B" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("Bakery").Range("B3:B" & bottomB)
If c.Value = "Flyer" Then
c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
x = x + 1
End If
Next c
End Sub
Similar to other solutions posted. Pretty simple. Replaces bounding for range checking. Fewest variables. No mid-execution dimensioning.
Sub CopyRowsFlyer()
Dim strSh As Variant, c As Range, x As Integer
x = 1
For Each strSh In Array("Bakery", "Floral", "Grocery")
For Each c In Worksheets(strSh).Range("B:B")
If c = "" and c.Row > 2 Then
Exit For
ElseIf c = "Flyer" and c.Row > 2 Then
c.EntireRow.Copy Worksheets("Sheet1").Range("A" & x)
x = x + 1
End If
Next
Next
End Sub
You just want to loop through the three sheets you want. Try this:
Sub CopyRowsFlyer()
'This looks in the Bakery tab and moves everything that has "Flyer" in column B to Sheet 1
Dim bottomB As Integer
Dim x As Integer
Dim SheetsArray() As Variant
Dim ws As WorkSheet
Dim i As Integer
SheetsArray = Array("Bakery", "Sheet2Name", "Sheet3Name")
For i = LBound(SheetsArray) To UBound(SheetsArray)
Set ws = Sheets(SheetsArray(i))
bottomB = ws.Range("B" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In ws.Range("B3:B" & bottomB)
If c.Value = "Flyer" Then
c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
x = x + 1
End If
Next c
Next i
End Sub
You can substitute an element of a string array for the ID in Sheets.
Here is your code modified to reflect.
Sub CopyRowsFlyer()
Dim bottomB As Integer
Dim x As Integer
Dim sheetName(1 to 3) As String, i as Integer
sheetName(1) = "Bakery"
sheetName(2) = "Floral"
sheetName(3) = "Grocery"
x=1
For i = 1 to 3
bottomB = Sheets(sheetName(i)).Range("B" & Rows.Count).End(xlUp).Row
Dim c As Range
For Each c In Sheets(sheetName(i)).Range("B3:B" & bottomB)
If c.Value = "Flyer" Then
c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
x = x + 1
End If
Next c
Next i
End Sub
Store the desired worksheet names in an array and loop through them.
Sub CopyRowsFlyer()
Dim bottomB As Long, b As Long, x As Long
Dim w As Long, vWSs As Variant
vWSs = Array("Bakery", "Floral", "Grocery")
x = 1
For w = LBound(vWSs) To UBound(vWSs)
With Worksheets(vWSs(w))
bottomB = .Range("B" & Rows.Count).End(xlUp).Row
For b = 3 To bottomB
If LCase(.Cells(b, "B").Value) = "flyer" Then
.Rows(b).EntireRow.Copy Worksheets("sheet1").Range("A" & x)
x = x + 1
End If
Next b
End With
Next w
End Sub
While this method of looping through the cells in each worksheet's column B is considered inefficient compared to other methods like the .Range.Find method, it will not make a lot of difference on smaller sets of data. If you have a large number of rows on each worksheet to examine, you may wish to explore other more direct avenues of retrieving the information.