Solved Multiple VBA Coding for that samne workbook.

May 11, 2017 at 16:57:47
Specs: Windows 7
This is a fantastic post and works very well. I just have one question; can you code two instance for the same spreadsheet in the same VBA window?

I have a workbook that calculates a Physicians Full Time Equivalent (FTE) to Relocation pay; works fantastic. That being said I would also like to take the FTE cell (D23) to automatically calculate the input in sign-on bonus (H25) to pro-rate what the sign on bonus would be variable to the FTE. and example would be a standard bonus of $30,000 prorated to .50 FTE should change to $15000. Is this something that can be done? Below is the code I used for the first instance:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$24" Then
'disable events
Application.EnableEvents = False
'multiply D23 value to H24 and save in H24
Range("H24").Value = Range("H24").Value _
* Range("D23").Value
End If
'reenable events
Application.EnableEvents = True
Exit Sub
'error handler
ErrHnd:
Err.Clear
'reenable events
Application.EnableEvents = True
End Sub


See More: Multiple VBA Coding for that samne workbook.

Report •

#1
May 12, 2017 at 02:12:35
✔ Best Answer
Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range

' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Filepath\"

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xls*")

' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)

' Set the source range.
Set SourceRange = WorkBk.Worksheets("DR02").Range("E20:M20")

' Set the destination range to start at column B and
' be the same size as the source range.
Set DestRange = SummarySheet.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)

' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value

' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count

' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False

' Use Dir to get the next file name.
FileName = Dir()
Loop

' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet.Columns.AutoFit
End Sub

Report •
Related Solutions


Ask Question