I am trying to get the value of column I from the A workbook. I have closed all other workbooks but not able to get correct values. It is displaying me the term "Balancing" every time which is not present in the workbook A. I am not getting where that word is coming from.
Sub newapproach()
Set ws1 = Workbooks("A.xlsx").Worksheets(1)
Workbooks("A.xlsx").Activate
lastRow11 = Range("I" & Rows.Count).End(xlUp).Row
For i = lastRow11 To 1 Step -1
If i <> "" Then
Value = Workbooks("A.xlsx").Worksheets(1).Cells(i, "I").Value
MsgBox (Value)
End If
Next i
End Sub
Related
Wondering if someone can help me reverse the below code. Essentially, I have a userform with a combobox that generates from a list of names from a worksheet column "A". Upon submit the selected items from userform are populated to the worksheet to the row of the corresponding name from the combobox.
I am hoping to somehow reverse the code below so I can place it in "UserForm_Initialize()" to regenerate saved values back to the texboxes on the form if user closes and reopens the same day. I have a current date textbox called "currentDate". So basically if Date = currentDate.Text Than...add cell value back to textboxes.
Dim dn As Worksheet: Set dn = Sheets("DailyNumbers")
Dim EmptyRow As Long
Dim FoundVal As Range
EmptyRow = dn.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1
' *** Check combobox selection ***
If procNamecombobox.ListIndex > -1 Then
Set FoundVal = dn.Range("A1:A" & EmptyRow).Find (procNamecombobox.Value) 'find Combobox value in Column A
If Not FoundVal Is Nothing Then 'if found
dn.Range("B" & FoundVal.Row).Value = currentDate.Text
dn.Range("C" & FoundVal.Row).Value = completeCount.Text 'use that row to populate cells
dn.Range("D" & FoundVal.Row).Value = handledCount.Text
dn.Range("E" & FoundVal.Row).Value = wipCount.Text
dn.Range("F" & FoundVal.Row).Value = suspendCount.Text
Else 'if not found use EmptyRow to populate Cells
dn.Range("A" & EmptyRow).Value = procNamecombobox.Value
dn.Range("B" & EmptyRow).Value = currentDate.Text
dn.Range("C" & EmptyRow).Value = completeCount.Text
dn.Range("D" & EmptyRow).Value = handledCount.Text
dn.Range("E" & EmptyRow).Value = wipCount.Text
dn.Range("F" & EmptyRow).Value = suspendCount.Text
End If
Else
MsgBox "Please select your name"
End If
Thank you!
I guess you could use something like this
Option Explicit
Private Sub UserForm_Initialize()
Dim f As Range
With Worksheets("DailyNumbers") 'reference wanted sheet
Set f = .Range("B1", .Cells(.Rows.Count, "B").End(xlUp)).Find(Date, lookat:=xlWhole, LookIn:=xlValues) 'search referenced sheet column B for current date
End With
If Not f Is Nothing Then ' if current date found
With Me 'reference userform
.completeCount.Text = f.Offset(, 1).value
.handledCount.Text = f.Offset(, 2).value
.wipCount.Text = f.Offset(, 3).value
.suspendCount.Text = f.Offset(, 4).value
End With
End If
'your other code to fill listbox
With Worksheets("NamesArchive") ' just a guess...
Me.procNamecombobox.List = Application.Transpose(.Range("A1", .Cells(.Rows.Count, "A").End(xlUp))) 'fill combobox with referenced sheet column A values from rows 1 down to last not empty one
End With
End Sub
BTW, your code could be refactored as follows:
Option Explicit
Private Sub CommandButton1_Click() ' just a guess...
Dim dn As Worksheet: Set dn = Sheets("DailyNumbers")
Dim emptyRow As Long
Dim foundRng As Range
With Me
With .procNamecombobox
If .ListIndex = -1 Then
MsgBox "Please select your name"
Exit Sub
End If
emptyRow = dn.Cells(dn.Rows.Count, "B").End(xlUp).Row + 1
Set foundRng = dn.Range("A1:A" & emptyRow).Find(.value) 'find Combobox value in Column A
If foundRng Is Nothing Then 'if no entry with input name
dn.Range("A" & emptyRow).value = .value 'fill column A first empty with input name
Else 'otherwise
emptyRow = foundRng.Row 'set found cell row index as the one to write in
End If
End With
Intersect(dn.Range("B:F"), dn.Rows(emptyRow)).value = Array(.currentDate.Text, .completeCount.Text, .handledCount.Text, .wipCount.Text, .suspendCount.Text) 'fill columns B to F proper row with textboxes values
End With
End Sub
To help get you started:
A)
Determine if there is a cell in column B with the current date. If so, locate it and use the .Row property to save the row number to a variable.
(There are a couple of range functions (.Find, .Search) that you can use to locate a cell with a particular value. For date's, this link has some helpful information.)
A.5) From the above link, if the dates are in Excel as serial dates -- not text -- then you can use
Set FoundCell = Range("A1:A100").Find _
(what:=Date,lookin:=xlFormulas)
to find the current date in column A from rows 1 to 100. VBA has a function Date() which returns the current day's date. Now() returns the current date and time, while Time() returns the current time.
B)
Set the .text values of the Text/Combo boxes to the values of the cells
(These can be located with a concatenation of the correct column with the saved row variable from earlier. Similar to how you located the cells to save the values initially)
If you're stuck on how to do a particular step or process, and can't find an existing Q&A with information, you can ask for elaboration.
I have two sheets "Data" - which has raw data and "Report" - as Report form .
Report sheet first 5 rows has info.
Data Sheet there 6 columns of Data available (SlNo Name Desig Place gender Category)
Report sheet has first 5 columns only (SlNo Name Desig Place gender)
Report sheet range C5 is dropdown box (List from Category column of Data sheet).
So based on this C5 value get details from Data sheet and paste in Report sheet.
I tried the following code but it pastes the whole row when I want to paste only Name,Desig,Place,gender details in offset and loop...
Sub ViewBtn()
Dim SCHL As String
Dim x As Long
x = 2
Do While Cells(x, 1) <> ""
Sheets("Report").Range(Cells(x, 1).Address, Cells(x, 5).Address).ClearContents
x = x + 1
Loop
Dim id As String
id = ActiveSheet.Range("C5").Value
x = 2
Sheets("Data").Select
Category = id
Do While Cells(x, 1) <> ""
If Cells(x, 4) = Category Then
Worksheets("Data").Rows(x).Copy
Worksheets("Report").Activate
erow = Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Report").Rows(erow)
End If
Worksheets("Data").Activate
x = x + 1
Loop
Application.CutCopyMode = False
Worksheets("Report").Activate
End Sub
Here is some sample code to do what I think you are asking for. It is not necessarily the shortest or cleverest way to do it, but everything is done step by step so I hope it is clear enough to follow easily.
Option Explicit
Private Sub viewBtn_Click()
'// Set references to worksheets
Dim wsReport As Worksheet: Set wsReport = Sheets("Report")
Dim wsData As Worksheet: Set wsData = Sheets("Data")
'// Get the category to be reported
Dim sCategory As String
sCategory = wsReport.Range("C5")
'// Reference first line of the report, in row 8
Dim rFirstReportLine As Range
Set rFirstReportLine = wsReport.Range("A8:E8")
'// Reference the line of the report to be written
Dim rReportLine As Range
Set rReportLine = rFirstReportLine
'// Clear the old report area
Do While rReportLine.Cells(1, 1) <> ""
rReportLine.Clear
Set rReportLine = rReportLine.Offset(1, 0)
Loop
'// Reset to first line of the report
Set rReportLine = rFirstReportLine
'// Find the first cell, if any, that matches the category
Dim rMatch As Range
Set rMatch = wsData.Range("F:F").Find(sCategory, , , xlWhole)
'// Get reference to top data row of data sheet, just the cols to be copied
Dim rDataRow As Range: Set rDataRow = wsData.Range("A1:E1")
'// check for at least one match
If Not rMatch Is Nothing Then
'// Save the address of the first match for checking end of loop with FindNext
Dim sFirstMatchAddress As String: sFirstMatchAddress = rMatch.Address
Do
'// 1) .. copy data row to the report line
rDataRow.Offset(rMatch.Row - 1).Copy rReportLine
'// 2) .. move the report line down
Set rReportLine = rReportLine.Offset(1, 0)
'// 3) .. find the next match on category
Set rMatch = wsData.Range("F:F").FindNext(rMatch)
'// 4) .. exit when we have looped around
Loop Until rMatch.Address = sFirstMatchAddress
End If
'// Display the number of entries found at the end of the report
With rReportLine
Dim nEntryCount As Integer: nEntryCount = .Row - rFirstReportLine.Row
.Cells(1, 1) = nEntryCount & IIf(nEntryCount = 1, " Entry", " Entries")
.Font.Italic = True
.Font.Color = vbBlue
End With
'// Make sure the report sheet is displayed
wsReport.Activate
End Sub
With this data
Get this result
I'm in the need of your help to solve the basic exercise I encountered during the course of learning Excel VBA. So, here it is:
There is a list of rollercoasters, where one column represents the name of the rollercoaster, whilst another column its type. I have to loop down the list, until the empty cell, selecting only those rollercoasters, the type of which is "Wooden". The sub should end with a message box displaying all rollercoasters' names, that matched our "Wooden" criterion (every line of msgbox contains one name).
So, anyone could advise a new learner how to cope with the above...?
This will run on the first 1000 rows where column a is the rollercoasters and column b is the type. you can cahnge the number 1000 to another number or xldown if you desire.
Sub Macro1()
'
Dim Rollers As String
For i = 1 To 1000
If Cells(i, 2) = "Wooden" Then Rollers = Rollers & vbNewLine & Cells(i, 1).Value
If Cells(i, 1) = "" Then MsgBox (Rollers): End
Next i
'
End Sub
I would add to Balinti's answer. This will get you the last row to use instead of hardcoding 1000
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Then you would have a loop that looked like this
For i = 1 To LastRow
Next i
MsgBox Rollers
I need a little bit help with a macro of Excel.
I need to create a macro that automatically find users and copy the values that i have in an other Sheet:
I have one sheet with values that contains the Users and their Kills and Deaths, I create 3 sheets more (3 different groups of users), and I need that the macro copy values automatically finding the users and copying values.
Images to describe it better:
----(Copy this values on)----->
You don't need a macro for this, using the worksheetfunction VLOOKUP is sufficient.
As an example, if you have your headers in row 1 and users in column A, what you'd put into cell B2 (the number of kills for the first user) would be =VLOOKUP($A2;Values!$A$2:$C$9;2;FALSE) and C2 would be =VLOOKUP($A2;Values!$A$2:$C$9;3;FALSE).
The arguments for the function (which you can also find in the linked document) is:
First, the value you're looking for, in your case whatever is in A2
Next the array of values which you want to return a result from - vlookup will only look through the first column, but since you want to return results from the other columns we include columns A:C in the formula.
What column in the range you search to return the result from for kills it is column 2, for deaths column 3.
Finally whether you want to have an exact match (false) or if an approximate one is ok (true).
If I understand what you're after, you should be able to do this with VLOOKUPs
(No VBA necessary)
The following source code solve your problem.
Option Explicit
Dim MyResultWorkbook As Workbook
Dim ValuesWorksheet As Worksheet
Dim SniperWorksheet As Worksheet
Dim ARsWorksheet As Worksheet
Sub CopyResult()
Set MyResultWorkbook = ActiveWorkbook
Set ValuesWorksheet = MyResultWorkbook.Sheets("Values")
Set SniperWorksheet = MyResultWorkbook.Sheets("Sniper")
Set ARsWorksheet = MyResultWorkbook.Sheets("Ars")
Dim SniperLastRow As Long
Dim ARLastRow As Long
Dim RowPointer As Long
Dim ValuePointer As Long
ValuePointer = 2
'Update the Sniper worksheets
SniperLastRow = SniperWorksheet.Cells(SniperWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To SniperLastRow
Do While (SniperWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
SniperWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
SniperWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
'Update the Ars worksheets
ARLastRow = ARsWorksheet.Cells(ARsWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To ARLastRow
Do While (ARsWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
ARsWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
ARsWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
End Sub
I'm a newbie to VBA and I'm writing a VBA code that will accept user inputs for the serial numbers for the Start and End value and will check if the serial numbers in another sheet fall between the range specified. If it does, then my code will pick the complete record and paste it into another sheet.
Now, the challenging part is that the serial number value isn't consistent and it could be alpha-numeric string with no fixed length. So, I've used StrComp function to check if the value lies in the range specified by the user. The problem is if the user types in a value for start value and end value that doesn't exist in the sheet of serial numbers then it goes on an infinite loop.
For instance, if there is a serial number say 1120 and the user enters 1110(which doesn't exist) for start value and 1200 for end value, the code goes on a infinite loop. Technically, the code should pick the serial number 1120 and return since it does lie in the range 1110 and 1200 eventhough the value 1110 doesn't exist in the sheet.
Here is my code:
'Assigining values enterted by user to variables
start = Me.txtStart.Value
finish = Me.txtEnd.Value
'Checking Upper bound Vs Lower bound
If (Len(start) <> 0 And (Len(finish) <> 0)) Then
If (StrComp(start, finish) > 0) Then
MsgBox ("Lower Bound cannot be higher than the Upper Bound")
Exit Sub
Else
If Len(tempWorkPriority) = 0 Then
MsgBox ("Enter a value for Work Priority")
Exit Sub
Else
If Len(tempDescription) = 0 Then
MsgBox ("Enter a value for Description")
Exit Sub
Else
Goto Here
End If
End If
End If
Else
result = MsgBox("Please enter values for Upper and Lower bounds")
Exit Sub
End If
End Sub
Here:
Sheets("Imported e-Facilities Data").Activate
'Number of rows in Raw Data sheet
RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'Loop to iterate and pick data that falls within the specified range
For i = 2 To RowCount
tempSerial = Range("A" & i).Value
tempAsset = Range("V" & i).Value
tempAssignedResource = Range("R" & i).Value
tempManufacturer = Range("F" & i).Value
'Condition to check if a Serial Number falls within the range
If (StrComp(start, tempSerial) <= 0 And StrComp(tempSerial, finish) <= 0) Then
'Selecting Export Sheet
Sheets("Data Ready for Import").Select
'Counting Rows in the Export sheet
RowCountExport = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A" & RowCountExport + 1).Value = tempSerial
End If
Next
End Sub
Please Help!!!
You're using unqualified calls to Range so you are relying on the active sheet being set correctly. When you find a serial number which falls within the range, you call Select on a different sheet which has the effect of changing the active sheet. The next time round your loop tempSerial, tempAsset etc will be read from the "Data Ready For Import" sheet which is now active rather than the "Imported e-Facilities Data" sheet which was being used before.
You should qualify your Range references instead of relying on the active sheet, Select or Activate:
Set wsInput = Worksheets("Imported e-Facilities Data")
tempSerial = wsInput.Range("A" & i).Value
or use With ... End With for repeated references to the same object:
Set wsInput = Worksheets("Imported e-Facilities Data")
With wsInput
tempSerial = .Range("A" & i).Value
tempAsset = .Range("V" & i).Value
tempAssignedResource = .Range("R" & i).Value
tempManufacturer = .Range("F" & i).Value
End With