Re: Help with this Formula/Code
Filename needs to contain the directory path as well as the filename. For example in brackets needs to contain something like [C:\Test\20130516_XX_IR_Uploadfinal_V1.0_12062013.xls]. Just change your Filename variable to include the directory of the file or add a second varibale that contains it and add it to the code.
link = "=INDIRECT(""[" & FilePath & Filename & "]" & sh & "!"" & RC[-1])"Re: Filter Per Selection From The Pull-down List
Hello,
You can use the code below and it should do what you are wanting. Now i added the for each loop at bottom to loop through each of the cells that are part of each filter. You can remove if you already have something otherwise this creates an array of the different possible times and then loops through each of the times and filters range for that time.
Public Sub subTimeFilter()
Dim rngFilterRange As Range, rngCell As Range
Dim strTimeFilters() As String, strMainSheet As String
Dim lngCounter As Long
'Assign Variables
strMainSheet = "People"
Set rngFilterRange = Sheets(strMainSheet).Range("A1:C" & Sheets(strMainSheet).Cells(Rows.Count, 2).End(xlUp).Row)
rngFilterRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("B1:B" & Sheets(strMainSheet).Cells(Rows.Count, 2).End(xlUp).Row), Unique:=True
lngCounter = 0
'Loop To Gather Possible Times
For Each rngCell In rngFilterRange.SpecialCells(xlCellTypeVisible)
If rngCell.Column = 2 And rngCell.Row <> 1 Then
ReDim Preserve strTimeFilters(lngCounter)
strTimeFilters(lngCounter) = rngCell.Value
lngCounter = lngCounter + 1
End If
Next
Sheets(strMainSheet).ShowAllData
Sheets(strMainSheet).AutoFilterMode = False
'Filter By Each Time
For lngCounter = 0 To UBound(strTimeFilters)
rngFilterRange.AutoFilter
rngFilterRange.AutoFilter field:=2, Criteria1:=Format(CDate(strTimeFilters(lngCounter)), "hh:MM")
For Each rngCell In rngFilterRange.SpecialCells(xlCellTypeVisible)
'This loops through all the cells that were filtered
Next
rngFilterRange.AutoFilter
Next
End SubRe: Trying to avoid GoTO - vba Loop containing Case
Hello,
You do not have to use the the GoTo statement. There are a number of different things you can do to avoid using GoTo but the first thing that comes to mind is to create a Boolean variable and just name it boolLoop or whatever you want then use it like i have in the code below and it will loop for you.
Dim boolLoop As Boolean
Set USER_rng = Worksheets(USER_ANALYSIS_WKST).Range("A3", Chr(Range("A2").End(xlToRight).Column + 64) & Range("A" & Rows.Count).End(xlUp).Row)
For Each USER_row In USER_rng.Rows
For Each USER_cell In USER_row.Cells
'Detect which HR attribute is under analysis
USER_Header_Detect = Worksheets(USER_ANALYSIS_WKST).Cells(2, USER_cell.Column).Value
'Populate Country Type row numbers
boolLoop = True
While boolLoop = True
boolLoop = False
Select Case USER_Header_Detect
Case "COUNTRY"
' Country Analysis Logic
Case "CITY"
' City Analysis Logic
Case "STATUS"
' Status Analysis Logic
Case Else
' pop-up to fix header
boolLoop = True ' I know this is not best-practice, but I can't think of an alternative.
End Select
Loop
Next USER_cell
' output based on analysis
Next USER_rowRe: Getting rid of helper columns
Hello,
You could use something like the below formula. Please ensure that once you place the formula into the cell you must edit the cell then instead of pressing enter press Ctrl-Shift-Enter to change it to array formula. Also as a note WEEKNUM is not compatible with a header row (as it includes incompatible values for WEEKNUM function) which is why I did not do the entire column and used an actual range instead. If you included the header row you would get a #VALUE error.
=SUM(IF((Queries!$F2:$F5000-Queries!$E2:$E5000>1),0,IF((WEEKNUM(Queries!$E2:$E5000+0)=A1),1,0)))
Re: How to click website link in Excel VBA?
Hello,
I have attached a spreadsheet and basically it will loop through all links on a website. It will paste the link information into a spreadsheet so that you can see general information about the links just for informational purposes. I am not sure how your site looks or the source code on it so I am unable to give exact code but you should be able to get the idea of how its done in the code I provided. I use USPS.com site as an example of how my code works and basically it goes to USPS.com and then sifts through all links on the page until it finds the Terms of Service hyperlink and then clicks on that link. To adapt it to your website look at the source code and check if the link on your site has something that is always in that link. For instance the text on the website for that link always says like 'Daily Report' or something that you can loop through and find that value and if it does then click that link or check if there is a static start to the link path like its always 'https://usps.com/archive/pagenumber' then a number at the end and you can search for the static part of the string. Please let me know if you need more help.
[ATTACH=CONFIG]54475[/ATTACH]
Re: Selecting ID based on condition
Hello,
I believe the easiest way is to just use a formula. It should do what you are wanting. When you go to copy the formula into your new spreadsheet and change the lookup values remember the following to make this type of formula work. Always instead of pressing enter after modifying this cell formula press Ctrl-Shift-Enter and it will encase your formula in brackets which will make the formula work (FYI - This is called an Array Formula). Below is the formula and the spreadsheet showing this formula.
{=IFERROR(INDEX($A$1:$A$15,MATCH(C2,IF($B$1:$B$15=2001,$C$1:$C$15),0)),INDEX($A$1:$A$15,MATCH(C2,IF($B$1:$B$15=1001,$C$1:$C$15),0)))}
[ATTACH=CONFIG]54470[/ATTACH]
Re: Help with this Formula/Code
Hello stildawn,
If column A always has the actual cell location within the other workbook you are trying to reference then use the code below.
link = "=INDIRECT(""[" & Filename & "]" & sh & "!"" & RC[-1])"Re: update information from one worksheet to another worksheet
Hello,
I understand I was thinking the formula was probably not going to be what you were looking for but it was easier:) .
I have attached the spreadsheet or you can copy the macro below. Let me know if this was not what you were looking for or needed something else added.
[ATTACH=CONFIG]54399[/ATTACH]
Public Sub subUpdateAdminSheet()
Dim strFindTmp As String, strAdminSheet As String, strWkDbrdSheet As String
Dim lngCounter As Long, lngCounter1 As Long, lngWD_WO_End As Long, lngWD_WO_Start As Long, lngAdminEnd As Long
Dim intItemsToUpdate As Integer, intCounter As Integer
strAdminSheet = "Admin"
strWkDbrdSheet = "Workstation Dashboard"
lngWD_WO_End = Sheets(strWkDbrdSheet).Cells(Rows.Count, 2).End(xlUp).Row
lngWD_WO_Start = 9
intItemsToUpdate = 13
lngAdminEnd = Sheets(strAdminSheet).Cells(Rows.Count, 3).End(xlUp).Row
For lngCounter = lngWD_WO_Start To lngWD_WO_End
For lngCounter1 = 1 To lngAdminEnd
If Sheets(strWkDbrdSheet).Cells(lngCounter, 2) = Sheets(strAdminSheet).Cells(lngCounter1, 3) Then
'Paste Data From Workstation Dashboard To Admin
For intCounter = 1 To intItemsToUpdate
Sheets(strAdminSheet).Cells(lngCounter1, 3 + intCounter) = Sheets(strWkDbrdSheet).Cells(lngCounter, 2 + intCounter)
Next
End If
Next
Next
End SubRe: update information from one worksheet to another worksheet
Hello,
Check out the spreadsheet and tell me if that works for you. Now I used just a vlookup to get the data to the admin tab. When you type a work order # into the admin tab and it has a record on the dashboard tab then the data from the dashboard tab will update the admin tab. Now I was unsure whether you were looking for a code solution instead of a formula both are simple the formula method is in the attached spreadsheet. Now if you are going to be dealing with tens of thousands of records then I wouldn't suggest the formulas since they will consume memory if dealing with larger sets of data to calculate.
[ATTACH=CONFIG]54398[/ATTACH]
Re: Save File as Name plus Todays Date in text format using Macro
Hello,
I don't see anything in the code that would actually change the number format. The 2nd part with the date is very simple replace the saveas portion of your code with the code below and your set as far as that goes. If you manually saved the file as text and then opened it does the number format still change? If you have the field with an invalid number like that it should be read in as text anyway.
ActiveWorkbook.SaveAs Filename:= _
"[URL="file://\\Sadnl\dfsnl\GRNL01\1650\Werkgroepen\Migratie\Cashbreaks"]\\Sadnl\dfsnl\GRNL01\1650\Werkgroepen\Migratie\Cashbreaks[/URL] Fanta\Team Funds\Cash Transfers & Format(date, "dd-mm-yyyy") &.txt" _
, FileFormat:=xlText, CreateBackup:=[COLOR=#0000ff]False[/COLOR]Re: Need Excel macro to get all combinations of a term
Hello,
I believe the attached spreadsheet or you can copy the code below will do what you are wanting. I am curious if by all combinations includes items in different orders. For example if we have in Cell A1, which is where the string is that I extract combinations from, we have 'Dog Bark Apple' would the total possible combinations be 6 or lets say we look at 'Dog Bark' then would you also count 'Bark Dog' since it is technically a different combination since the order is different. Check it out and let me know if you want it changed or not or if you have any questions.
[ATTACH=CONFIG]54396[/ATTACH]
Public Sub CombinationsBySpace()
Dim strTmp() As String
Dim intCounter As Integer, intCounter1 As Integer, intCounter2 As Integer, intRow As Integer
strTmp = Split(Cells(1, 1), " ")
For intCounter = 0 To UBound(strTmp)
For intCounter1 = 0 To UBound(strTmp)
intRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
For intCounter2 = 0 To intCounter1
If intCounter2 >= intCounter Then
Sheets("Sheet1").Cells(intRow, 1) = Sheets("Sheet1").Cells(intRow, 1) & " " & strTmp(intCounter2)
End If
Next
'Check if set already exists
For intCounter2 = 2 To intRow - 1
If Sheets("Sheet1").Cells(intCounter2, 1) = Sheets("Sheet1").Cells(intRow, 1) Then Sheets("Sheet1").Cells(intRow, 1).Delete Shift:=xlUp
Next
Next
Next
End SubRe: Clearing sheets from a list, except the first row
Hello,
Add the following line of code just before you perform the copy. Also always remember to wrap code when you place into the forumns so that it will be easier for us to read and paste into VBA editor
Worksheets(MySh).Rows("2:" & Rows.Count).Delete Shift:=xlUpRe: Help with this Formula/Code
Hello,
Replace the link= line with the one below and it should work fine. Indirect funtion is not necessary here.
link = "=[" & Filename & "]" & sh & "!RC[-1]"Re: Random shuffling of data in rows
Hello,
Try this spreadsheet or copy the code below into your code. If you look in the VBA editor at the tree view on the left hand side it shows all the worksheets, modules, classes, userforms for your project. If you select 'Workbook' from the tree view and paste the code there it will run on workbook open or you could just use the attached file. Fixed the loop went one too many times for the samples and the numbering now starts at 1 instead of 0 for both participants and samples.
[ATTACH=CONFIG]54390[/ATTACH]
Private Sub Workbook_Open()
Dim intCounter As Integer, intSamplesCount As Integer, intParticipantCount As Integer, intCounter1 As Integer, intCounter2 As Integer, intTmp As Integer
Dim ParticipantCount As Variant, SampleCount As Variant
Dim strSamples() As String, strTmp() As String
Dim oSheet As Worksheet, oSheet1 As Worksheet
'Participant Count
ParticipantCount = Application.InputBox("Number of Participants", "Participant Count", 30)
If ParticipantCount = vbNullString Or ParticipantCount = False Then Exit Sub
intParticipantCount = ParticipantCount
'Sample Count
SampleCount = Application.InputBox("Number of Samples", "Sample Count", 12)
If SampleCount = vbNullString Or SampleCount = False Then Exit Sub
intSamplesCount = SampleCount
ReDim strSamples(intSamplesCount - 1)
ReDim strTmp(intSamplesCount - 1)
Set oSheet = Sheets("Sheet1")
Set oSheet1 = Sheets("Sheet2")
oSheet.Cells.ClearContents
oSheet1.Cells.ClearContents
For intCounter = 0 To intSamplesCount - 1
strSamples(intCounter) = Int((999 - 100 + 1) * Rnd + 100)
oSheet.Cells(1, intCounter + 2) = "S" & intCounter + 1
oSheet1.Cells(1, intCounter + 2) = "S" & intCounter + 1
Next
For intCounter = 0 To intParticipantCount - 1
oSheet.Cells(intCounter + 2, 1) = "P" & intCounter + 1
oSheet1.Cells(intCounter + 2, 1) = "P" & intCounter + 1
'Reset Temp Array Element
For intCounter1 = 0 To intSamplesCount - 1
strTmp(intCounter1) = ""
Next
For intCounter1 = 0 To intSamplesCount - 1
intTmp = Int(((intSamplesCount - 1) + 1) * Rnd)
strTmp(intCounter1) = strSamples(intTmp)
intCounter2 = -1
Do While intCounter2 < intCounter1 - 1
intCounter2 = intCounter2 + 1
If strTmp(intCounter2) = strTmp(intCounter1) Then
intCounter2 = -1
intTmp = Int(((intSamplesCount - 1) + 1) * Rnd)
strTmp(intCounter1) = strSamples(intTmp)
End If
Loop
oSheet.Cells(intCounter + 2, intCounter1 + 2) = strTmp(intCounter1)
oSheet1.Cells(intCounter + 2, intCounter1 + 2) = intTmp
Next
Next
End SubRe: If cell contains "thisword" replace the entire cell with "thatword"
Hello,
The following code should do what you are wanting. Please let me know if this was not what you were looking for. Keep in mind this will search the entire spreadsheet for 'GE' so if a word in another cell contains 'GE' this would change that cells value like a name field on that spreadsheet with 'George' would change that field to 'GE BIO'. To fix that change the Set acell line with the code below and change the range to whatever is needed.
VBA:
Set aCell = Sheets("Sheet1").Range("A:A").Find(What:="GE", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)VBA:
Public Sub subChangeGE()
Dim aCell As Range
Dim strTmp As String
Set aCell = Sheets("Sheet1").Cells.Find(What:="GE", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
On Error Resume Next
strTmp = aCell.Address
On Error GoTo 0
Do While Not aCell Is Nothing
aCell = "GE BIO"
Set aCell = Sheets("Sheet1").Cells.FindNext(After:=aCell)
If strTmp = aCell.Address Then Exit Do
Loop
End SubRe: Macro to find substring, insert row, move text from adjacent cell to new row
Hello,
The attached file contains a macro that should work for you. Also the code for the macro is below. Just change the reference to the Sheet name when you copy into your spreadsheet and you should be good to go. Please let me know if you were looking for something different.
[ATTACH=CONFIG]54383[/ATTACH]
VBA:
Public Sub FindStation()
Dim strWordToFind As String, strSheetProcess As String
Dim lngCounter As Long, lngLastCell As Long, lngStartCell As Long
lngLastCell = Selection.SpecialCells(xlCellTypeLastCell).Row
lngStartCell = 2
strWordToFind = "station"
strSheetProcess = "TestPage"
For lngCounter = lngStartCell To lngLastCell
If InStr(LCase(Sheets(strSheetProcess).Range("A" & lngCounter)), strWordToFind) > 0 Then
Sheets(strSheetProcess).Rows(lngCounter + 1).Insert shift:=xlDown
Sheets(strSheetProcess).Range("B" & lngCounter).Cut Sheets(strSheetProcess).Range("A" & lngCounter + 1)
lngCounter = lngCounter + 1
End If
Next
End SubRe: Random shuffling of data in rows
Hello,
The attached spreadsheet should have it built the way you are wanting. If you just want the code it is below. Let me know if this was not what you were looking for.
[ATTACH=CONFIG]54370[/ATTACH]
Public Sub GenerateData()
Dim intCounter As Integer, intSamplesCount As Integer, intParticipantCount As Integer, intCounter1 As Integer, intCounter2 As Integer, intTmp As Integer
Dim ParticipantCount As Variant, SampleCount As Variant
Dim strSamples() As String, strTmp() As String
Dim oSheet As Worksheet, oSheet1 As Worksheet
'Participant Count
ParticipantCount = Application.InputBox("Number of Participants", "Participant Count", 30)
If ParticipantCount = vbNullString Or ParticipantCount = False Then Exit Sub
intParticipantCount = ParticipantCount
'Sample Count
SampleCount = Application.InputBox("Number of Samples", "Sample Count", 12)
If SampleCount = vbNullString Or SampleCount = False Then Exit Sub
intSamplesCount = SampleCount
ReDim strSamples(intSamplesCount)
ReDim strTmp(intSamplesCount)
Set oSheet = Sheets("Sheet1")
Set oSheet1 = Sheets("Sheet2")
oSheet.Cells.ClearContents
oSheet1.Cells.ClearContents
For intCounter = 0 To intSamplesCount
strSamples(intCounter) = Int((999 - 100 + 1) * Rnd + 100)
oSheet.Cells(1, intCounter + 2) = "S" & intCounter
oSheet1.Cells(1, intCounter + 2) = "S" & intCounter
Next
For intCounter = 0 To intParticipantCount - 1
oSheet.Cells(intCounter + 2, 1) = "P" & intCounter
oSheet1.Cells(intCounter + 2, 1) = "P" & intCounter
'Reset Temp Array Element
For intCounter1 = 0 To intSamplesCount - 1
strTmp(intCounter1) = ""
Next
For intCounter1 = 0 To intSamplesCount
intTmp = Int((intSamplesCount + 1) * Rnd)
strTmp(intCounter1) = strSamples(intTmp)
intCounter2 = -1
Do While intCounter2 < intCounter1 - 1
intCounter2 = intCounter2 + 1
If strTmp(intCounter2) = strTmp(intCounter1) Then
intCounter2 = -1
intTmp = Int((intSamplesCount + 1) * Rnd)
strTmp(intCounter1) = strSamples(intTmp)
End If
Loop
oSheet.Cells(intCounter + 2, intCounter1 + 2) = strTmp(intCounter1)
oSheet1.Cells(intCounter + 2, intCounter1 + 2) = intTmp
Next
Next
End SubRe: Searching a folder for a keyword and returning the full path
Hello,
I have a question on how you would determine the subfolders and actual filename for the unique files you are wanting to attach. The below VBA, or you can open the attachment, will work for this but you will need to fill in the actual filename for the static file. I can update the VBA for navigating to the right subfolder and getting the actual filename for the unique file so it can be attached if you could tell me how, from the data provided via the spreadsheet, to navigate to the right subfolder and then how the filename is generated. For instance is the subfolder always the provider name on the spreadsheet and is the filename for the unique file contain the reference number?
[ATTACH=CONFIG]54367[/ATTACH]
Private Const strMainSheet As String = "Sheet1"
Public Sub dsa()
Dim oOutlook As Outlook.Application
Dim oMsg As Outlook.MailItem
Dim oRng As Range
Dim lngRCount As Long, lngCounter As Long
Dim strBody As String, strTo As String, strCC As String, strStaticFilePath As String, strDynamicFilePath As String
Set oOutlook = GetObject(, "Outlook.Application")
lngRCount = Selection.SpecialCells(xlCellTypeLastCell).Row
For lngCounter = 2 To lngRCount
'Standard Message Information
strBody = "Type whatever you want to be in the body here."
strTo = Sheets(strMainSheet).Range("E" & lngCounter)
strCC = ""
strStaticFilePath = ActiveWorkbook.Path & "\" & StaticFileName 'Change StaticFileName To whatever your file name is with the extension
'Dynamic File
strDynamicFilePath = ActiveWorkbook.Path & "\" & StaticFileName 'Will need more info as far as how the unique files work such as what from the data provided can be used to navigate to the correct subfolder and how can we determine the actual filename.
'Create Message Item
Set oMsg = oOutlook.CreateItem(olMailItem)
'Set Message Information
With oMsg
.To = strTo
.CC = strCC
.Body = strBody
.Attachments.Add strStaticFilePath
.Attachments.Add strDynamicFilePath
'I dont do send until i am finished so i just save as draft email. Change the below to .Send when you are ready for production.
.Save
End With
Set oMsg = Nothing
Next
Set oOutlook = Nothing
End SubRe: Return Sheet Name Containing Text In A Cell
Hello,
How many records on average are on each of the 850 sheets?
Re: Copy rows to different sheet starting at a specific row.
Hello,
The offset at the end of this line of code determines where the paste will occur. For instance if you change Offset(1, 0) to
Offset(0, 0) then the paste will occur at A1. Please let me know if you need any other help on this or you dont understand.