How can I get excel to list me all available environmental variables on my "temp" sheet? Below code doesnt return anything for me...
Sub ListEnvironVariables()
Dim strEnviron As String
Dim i As Long
For i = 1 To 255
strEnviron = Environ(i)
If LenB(strEnviron) = 0& Then Exit For
Debug.Print strEnviron
Next
End Sub
Thanks
few lines modified from your code as below.
Sub ListEnvironVariables()
Dim strEnviron As String
Dim i As Long
For i = 1 To 255
strEnviron = Environ(i)
If LenB(strEnviron) = 0& Then Exit For
With Worksheets("temp")
.Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value = strEnviron
End With
Next
End Sub
Now I have changed the coding . This will list out all of the environment variables in your immediate window. If you can't see this, choose this menu option:
Sub ListEnvironmentVariables()
'each environment variable in turn
Dim EnvironmentVariable As String
'the number of each environment variable
Dim EnvironmentVariableIndex As Integer
Dim i As Long
'get first environment variables
EnvironmentVariableIndex = 1
EnvironmentVariable = Environ(EnvironmentVariableIndex)
'loop over all environment variables till there are no more
Do Until EnvironmentVariable = ""
'get next e.v. and print out its value
With Worksheets("temp")
.Cells(i, 1).Value = EnvironmentVariableIndex
.Cells(i, 2).Value = EnvironmentVariable
End With
'go on to next one
EnvironmentVariableIndex = EnvironmentVariableIndex + 1
i = i + 1
EnvironmentVariable = Environ(EnvironmentVariableIndex)
Loop
End Sub
Plz look into this also for further reference
http://www.wiseowl.co.uk/blog/s387/environment-variable-vba.htm
Related
Basically what I'm trying to do here is use this sub:
Sub SelectFirstBlankCell()
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
sourceCol = ActiveCell.Column 'Uses ActiveCell.Column as reference now, but needs to fit into each Subroutine to select next available
rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
'for every row, find the first blank cell and select it
For currentRow = 1 To rowCount
currentRowValue = Cells(currentRow, sourceCol).Value
If IsEmpty(currentRowValue) Or currentRowValue = "" Then
Cells(currentRow, sourceCol).Select
Exit For
End If
Next
End Sub
To find the next empty cell in a column to input the string from this sub into.
Set selRange = Selection
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
If strApps = "" Then
strApps = ListBox1.List(i)
intAppCodeOffset = i
strAppCodeVal = Worksheets("TestSheet").Range("B31").Offset(i, 0).Value
Else
strApps = strApps & ", " & ListBox1.List(i)
intAppCodeOffset = i
strAppCodeVal = strAppCodeVal & ", " & Worksheets("TestSheet").Range("B31").Offset(i, 0).Value
End If
End If
Next
Set selRange = selRange.Offset(1, 0)
With selRange
selRange.Value = strAppCodeVal
End With
I've tried replacing selRage.Offset(1, 0) with SelectFirstBlankCell, but I get an object reference error every time. Any help would be greatly appreciated on this as I can't seem to find how to do it on here.
As mentioned in the comments above, try changing Sub to Function, like this:
Function SelectFirstBlankCell(sourceCol as Integer) as Range
(remove old sourceCol dim and assignment)
...
Set SelectFirstBlankCell = Cells(currentRow, sourceCol)
...
End Function
Then you can do your change:
Set selRange = SelectFirstBlankCell(ActiveCell.Column) 'Or whatever you think should be defined as the sourceCol
Your code should probably not select anything itself, unless that is the end result of your macro. Try to use the code to directly manipulate the cells instead.
I'am on VBA trying to create a macro that record in different cell the number of times the workbook is open. Each time it is open, it creates a new cell with the number of the opening. So I created a counter for that.
Option Explicit
Dim i As Integer
Private Sub Workbook_Open()
If i = "" Then
i = 1
End If
ThisWorkbook.Worksheets("Feuil1").Cells(i, 1).Value = "Session " & i
i = i + 1
Debug.Print i
End Sub
However, the statement If i = "" remains highlighted in yellow, and I don't understand why...
Would someone have a solution?
Thank you !
i is an Integer so comparison to an empty String is not valid.
The closest thing you can do is
If i = 0 Then
But if you want the value to i to persist when you save the workbook, the simplest thing to do is to read its value from the workbook.
Of course you cannot assign a string to an integer. This is a type mismatch error.
What you need is to fetch the last cell in the column and then increment it.
Private Sub Workbook_Open()
' Fetch the last cell from column 1
Dim r As Range
With ThisWorkbook.Worksheets("Feuil1")
Set r = .Cells(.Rows.Count, 1).End(xlUp)
End With
' Get the last session number, or 0 if not present or doesn't match
Dim lastSession As Long: lastSession = 0
If Not IsEmpty(r) Then
Dim p As Long: p = InStr(1, Trim(r.value), "Session ")
If p = 1 Then
lastSession = CLng(Mid(r.value, p + Len("Session "), 10000))
End If
End If
r.Offset(1).value = "Session " & (lastSession + 1)
End Sub
I'd go like follows
Private Sub Workbook_Open()
With Worksheets("Feuil1")
With .Cells(.Rows.Count, 1).End(xlUp)
.Offset(1) = "Session " & Val(Replace(.Value, "Session ", "")) + 1
End With
End With
End Sub
I need to be able to loop through my rows (specifically, column B), and use the number in a certain cell in order to do specific functions using other cells in that row. For example, Rule #1 indicates that I need to find last modified date of the path in the cell next to the Rule #, but the task is different for each Rule.
I'm new to VBA and I've just been struggling with setting up a loop and passing variables to different subs, and would hugely appreciate any help. To be clear, I'm looking for syntax help with the loop and passing variables
Thank you!
Reference Images: The spreadsheet
The attempt at sketching out the code
Private Sub CommandButton1_Click()
Dim x As Integer
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
For x = 1 To NumRows
If Range(RowCount, 1).Value = 1 Then
RuleOne (RowCount)
End If
Next
'Dim RowCount As Integer
'RowCount = 1
'Worksheets("Sheet2").Cells(1, 2) = Worksheets("Sheet1").UsedRange.Row.Count
'While RowCount < Worksheets("Sheet1").Rows
'If Worksheets("Sheet1").Cells(RowCount, 1).Value = 1 Then
'RuleOne (RowCount)
'End If
'Wend
End Sub
Sub RuleOne(i As Integer)
'use filedatetime and path from i cell
'Worksheets("Sheet2").Cells(1, 1) = FileDateTime(C, i)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub
Sub RuleTwo(i As Integer)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub
Try to change the Range(RowCount, 1).Value = 1 to Cells(x, 2).Value = 1.
The variable RowCount has not been initialised/set.
I assume this is what this variable is meant to be the number in column B
RowCount = Cells(x, "B").Value
I also noticed that the variable NumRows seemed to be one less than it should be (so if the last row was 1 it would skip it). So I used this instead:
NumRows = Cells(Rows.Count, "B").End(xlUp).Row
So try this code:
Sub CommandButton1_Click()
Dim x As Integer
NumRows = Cells(Rows.Count, "B").End(xlUp).Row
For x = 1 To NumRows
RowCount = Range("B" & x).Value
If RowCount = 1 Then
RuleOne (x)
End If
Next
'Dim RowCount As Integer
'RowCount = 1
'Worksheets("Sheet2").Cells(1, 2) = Worksheets("Sheet1").UsedRange.Row.Count
'While RowCount < Worksheets("Sheet1").Rows
'If Worksheets("Sheet1").Cells(RowCount, 1).Value = 1 Then
'RuleOne (RowCount)
'End If
'Wend
End Sub
Sub RuleOne(i As Integer)
'use filedatetime and path from i cell
'Worksheets("Sheet2").Cells(1, 1) = FileDateTime(C, i)
Worksheets("Sheet2").Cells(1, i) = "hello"
End Sub
Sub RuleTwo(i As Integer)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub
Can some body help me with the reason why below code is returning "sub or function not defined" when I attempt to run a module.
Sub Tokenize()
Dim txt As String
Dim i As Integer
Dim FullName As Variant
For Counter = 1 To 300
Set curCell = Worksheet("Sheet1").Cells(Counter, 1)
txt = curCell.Value
FullName = Split(txt, " ")
For i = 0 To UBound(FullName)
Cells(Counter, i + 1).Value = FullName(i)
Next i
Next Counter
End Sub
I suspect the error is in this line:
Set curCell = Worksheet("Sheet1").Cells(Counter, 1)
^^^
You should replace Worksheet with Worksheets (notice the additional s).
I Have a Red Lion Data station that records temperatures from about 25 ovens and the data is stored on a network in CSV files. I would like to import this data into an Excel file once every two minutes, but only import the changes after the initial import. After the import, the VBA must release the CSV file for the 2 minutes so that it can be updated by the data station. I have searched the web, this site and the closest thing I have found is the following code. This code looks for changes but it does not import the file. any help would be appreciated.
Dim NextTime As Date
Function LastModTime(FileSpec As String) As Date
'Returns the date-time the file specified by FileSpec (path string) was last modified
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(FileSpec)
LastModTime = f.DateLastModified
End Function
Sub Check4Changes()
'Checks the file FilePath for changes every 60 seconds
'If file has changed, pops up a message box. Stores the
'last modified time in cell M1 of Sheet1
ChDir "Q:\Manufacturing\Equipment\DispatchLogs\logs\7-DES"
Const FilePath As String = "Q:\Manufacturing\Equipment\DispatchLogs\logs\7-DES\*.csv"
Dim LastMod As Date
On Error GoTo ReSchedule
LastMod = LastModTime(FilePath)
With Worksheets("Sheet1").Range("C1")
If IsEmpty(.Value) Then
.Value = LastMod
GoTo ReSchedule
ElseIf .Value < LastMod Then
.Value = LastMod
MsgBox FilePath & " updated.", vbInformation, "Check4Changes"
End If
End With
ReSchedule:
'Reschedule this same routine to run in one minute.
NextTime = Now + 2 / 1440
Application.StatusBar = "Next check at " & NextTime
Application.OnTime NextTime, "Check4Changes"
End Sub
Sub CancelChecking()
Application.OnTime NextTime, "Check4Changes", Schedule:=False
Application.StatusBar = False
End Sub
I have written some code which will give you the basic idea
Sub Main()
Dim Wbk_CSV As Excel.Workbook
Dim Excel_Wbk As Excel.Workbook
Dim Var_WholeCSVData As Variant
Dim Var_ExcelData As Variant
Dim Var_ToUpdate As Variant
Dim NumOfRows As Long
Dim Last_Row As Long
Set Wbk_CSV = Workbooks.Open("PathWithFileName")
Wbk_CSV.Sheets(1).Activate
Last_Row = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'Taking whole data in a variant
'Change the range as per the data in csv file
Var_WholeCSVData = Wbk_CSV.Sheets(1).Range("A2:D" & Last_Row).Value 'Considering first row as header row and there are 4 columns
'After taking whole data in varinat close csv file without saving
Wbk_CSV.Close savechanges:=False
Set Wbk_CSV = Nothing
'Now open excel file in which data will be updated
Set Excel_Wbk = Workbooks.Open("PathWithFileName")
Excel_Wbk.Sheets(1).Activate
Last_Row = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Var_ExcelData = Excel_Wbk.Sheets(1).Range("A2:D" & Last_Row).Value 'Considering first row as header row
NumOfRows = 0
'This function will return count of updated rows and data to update
Var_ToUpdate = Delete_Duplicates(Var_WholeCSVData, Var_ExcelData, NumOfRows)
Excel_Wbk.Sheets(1).Activate
'paste data
If NumOfRows > 0 Then
ActiveSheet.Range("A" & Last_Row + 1 & ":D" & Last_Row + NumOfRows).Value = Var_ToUpdate
End If
Excel_Wbk.Close savechanges:=True
Set Excel_Wbk = Nothing
'result
MsgBox ("Number of rows imported: " & NumOfRows)
End Sub
Function Delete_Duplicates(Var_FromCSV As Variant, Var_FromExcel As Variant, ByRef NumberOfRowToupdate As Long) As Variant
'using dictinpary objects
Dim dict_Duplicates As Object
Dim i_AddToDict, i, j As Long
Dim Str_value As String
Dim Var_Temp As Variant
Dim lng_temp As Long
Set dict_Duplicates = CreateObject("Scripting.Dictionary")
ReDim Var_Temp(1 To UBound(Var_FromCSV, 1), 1 To UBound(Var_FromCSV, 2))
'Add excel data to dict. by concatenating
'All unique values will be added
For i_AddToDict = 1 To UBound(Var_FromCSV)
Str_value = CStr(Var_FromExcel(i_AddToDict, 1) & Var_FromExcel(i_AddToDict, 2) & Var_FromExcel(i_AddToDict, 3) & Var_FromExcel(i_AddToDict, 4))
If dict_Duplicates.exists(Str_value) Then
'do nothing
Else
dict_Duplicates.Add Str_value, 1
End If
Next i_AddToDict
'looking for values which are not available in excel file
For i = 1 To UBound(Var_FromCSV)
Str_value = CStr(Var_FromCSV(i_AddToDict, 1) & Var_FromCSV(i_AddToDict, 2) & Var_FromCSV(i_AddToDict, 3) & Var_FromCSV(i_AddToDict, 4))
If dict_Duplicates.exists(Str_value) Then
'do nothing
Else
'storing values in a variant
For j = 1 To 4
Var_Temp(lng_temp, j) = Var_FromCSV(i, j)
Next j
lng_temp = lng_temp + 1
dict_Duplicates.Add Str_value, 1
End If
Next i
NumberOfRowToupdate = lng_temp - 1
Delete_Duplicates = Var_Temp
End Function