Posts by Oracle2054

Re: formualae to export row from one sheet to another paid invoices

Hello,

Copy the following code into a VB module and run it and it will do what I believe you are trying to do. There is unfortunately no formula that I am aware of that would do what you are wanting that can show them all like this so VBA is the only way to go here. It looks up the value in column E and checks for "Paid" if it finds it then it copies that row into the "Remittances" Sheet. Hope This Helps!!!

Sub PlaceRowsIntoRemittance()
Dim X, Y As Long
X = 1
Sheets("Remittances").Select
Range("A1").Select
'Cells.Select ' To delete the contents on Remittances Sheet before writing to it remove comment marks on these two lines
'Selection.Delete Shift:=xlUp
If Range("A1") <> "" Then
Selection.SpecialCells(xlCellTypeLastCell).Select 'Also comment this line out if you want to delete everything on remittances
End If
Y = ActiveCell.Row + 1
Do
If Sheets("z purchase book").Range("E" & X) = "Paid" Then
Sheets("z purchase book").Select
Rows(X & ":" & X).Select
Selection.Copy
Sheets("Remittances").Select
Rows(Y & ":" & Y).Select
ActiveSheet.Paste
Y = Y + 1
End If
X = X + 1
Loop Until Sheets("z purchase book").Range("A" & X) = ""
End Sub

Re: Use list of 400 text 'C:\path\[filenames.xls]SheetNames'! to pull cell values

Hello,

Paste The Following code into your VB and it will do what you want I believe. Now there is a few things I need to point out as I'm not entirely sure the format you are wanting to use to grab the files. Basically you type into column A all the names of the files just the names. In the code where it says FolderPathName put the path to the folder where all of these are stored and it will do the rest. It will paste the results onto a new sheet called "Results" that it makes. Also it will only look at Sheet1 on these other workbooks and it will select only cell B9 so just making sure that is correct. Hope This Helps!!!!

If you have any further questions I'd be more than happy to help or if you were looking for something a little different I just need a little more info or an example sheet of what you are looking for but this should be good.

Sub GrabInfoOtherBooks()
Dim X As Integer
Dim SheetName1, FolderPathName As String
SheetName1 = ActiveSheet.Name
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Results"
FolderPathName = "C:\"
X = 1
Do
'Sheets("Results").Range("A" & X).Select
'    ActiveCell.FormulaR1C1 = "='" & Sheets(SheetName1).Range("A" & X) & "'!R9C2" 'this will only work if column A
                                                                 'has correctly formatted data to work if not and you
                                                                 'only have like the filename then comment this out and
                                                                 'use the line below
Sheets("Results").Range("A" & X).Select
    ActiveCell.FormulaR1C1 = "='" & FolderPathName & "[" & Sheets(SheetName1).Range("A" & X) & "]Sheet1'!R9C2"
X = X + 1
'Loop Until X = 3 'remove this and put number of workbooks you want to pull the information from or comment out this line and use line below
Loop Until Sheets(SheetName1).Range("A" & X) = "" ' This will loop until column A hits a blank cell and paste it into a new sheet


End Sub

Re: Excel concatenate / rollup list of names macro

Hello,

Paste the following code into your VB and it will do it make sure the sheetname in VB shows it as Sheet1 and the results will display in sheet2 if you wanted to change it to the tab name then use the code in the second code box. Otherwise just use the code in the box directly below this not the bottom one. Hope This Helps!!!!

Sub TransposingData()
Dim X, Y As Long
X = 2
Do
'Determines Which Line To Put Data In Depending On Whether There North, South, ETC...
If Sheet1.Range("A" & X) = "North" Then
Y = 1
ElseIf Sheet1.Range("A" & X) = "South" Then
Y = 2
ElseIf Sheet1.Range("A" & X) = "East" Then
Y = 3
ElseIf Sheet1.Range("A" & X) = "West" Then
Y = 4
End If
'Pastes Data into Sheet2
If Sheet2.Range("B" & Y) = "" Then
Sheet2.Range("B" & Y) = Sheet1.Range("B" & X)
Else
Sheet2.Range("B" & Y) = Sheet2.Range("B" & Y) & "; " & Sheet1.Range("B" & X)
End If
'loops until it reaches a blank make sure there are not empty cells between the beginning and end in column A
'before you start
X = X + 1
Loop Until Sheet1.Range("A" & X) = ""
End Sub

Sub TransposingData()
Dim X, Y As Long
X = 2
Do
'Determines Which Line To Put Data In Depending On Whether There North, South, ETC...
If Sheets("SheetName").Range("A" & X) = "North" Then
Y = 1
ElseIf Sheets("SheetName").Range("A" & X) = "South" Then
Y = 2
ElseIf Sheets("SheetName").Range("A" & X) = "East" Then
Y = 3
ElseIf Sheets("SheetName").Range("A" & X) = "West" Then
Y = 4
End If
'Pastes Data into Sheet2
If Sheets("Destination SheetName").Range("B" & Y) = "" Then
Sheets("Destination SheetName").Range("B" & Y) = Sheets("SheetName").Range("B" & X)
Else
Sheets("Destination SheetName").Range("B" & Y) = Sheets("Destination SheetName").Range("B" & Y) & "; " & Sheets("SheetName").Range("B" & X)
End If
'loops until it reaches a blank make sure there are not empty cells between the beginning and end in column A
'before you start
X = X + 1
Loop Until Sheets("SheetName").Range("A" & X) = ""
End Sub

Re: Auto copy/paste and rename sheet from text box and command button

Hello,

Paste the following code into VB and link it to the command button and it will grab the name from a textbox labeled textbox1. Then it will rename and copy everything from the template sheet now for the template sheet you will need to rename the sheet to whatever you call that sheet and it will work. Hope This Helps!!!

Sub SheetSub()
Dim SheetName1, SheetName2 As String
SheetName1 = TextBox1.Text
SheetName2 = ActiveSheet.Name
 
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = SheetName1
 
Sheets("Place Template Sheet Name Here").Select
'will copy everything
Cells.Select
Selection.Copy
Sheets(SheetName1).Select
ActiveSheet.Paste
'goes back to where you started
Sheets(SheetName2).Select
End Sub

Re: How To Run code Before Print Preview

Hello,

Paste the following code into VB in the "ThisWorkbook" sheet and it will run before a print preview or before printing. Hope This Helps!!!!

Private Sub Workbook_BeforePrint(Cancel As Boolean)
 
'Insert Code Here
 
End Sub

Re: How To Run code Before Print Preview

Hello,

Paste

Private Sub Workbook_BeforePrint(Cancel As Boolean)
 
'Insert Code Here
 
End Sub

Re: VBA script to collect data from multiple worksheets

I can help you with this I will post the code within the next 15-30 minutes. Now on this all you are wanting is to have the data pulled from multiple worksheets to the summary sheet for any cert # that matches the elevator number that is entered into the summary sheet.

Re: Vacation Tracking Formula

To account for any rollover time the formula will need to be changed a little if there is a place you store that information just link it with column H like you did with column E. You will need to add a column to account for the rollover time from last year and there is not a formula that i am aware of that will always count the rollover vacation time so it will have to be changed each time there Hire Date hits again the amount of vacation that was unused would need to be put into column H. Below is the revised formula to account for rollover time entered into Column H.

=IF(C3>=10,(G3*$N$6)+H3,IF(C3>=5,(G3*$N$5)+H3,IF(C3>=3,(G3*$N$4)+H3,IF(C3>=1,(G3*$N$3)+H3,(G3*$N$3)+H3))))

Re: Vacation Tracking Formula

Hello,

Im Sorry for the delayed respons been real busy at work but I did take another look and if you are wanting to do the calculation based on when they were hired then it will be a little different the spreadsheet i have attached has the formulas and the correct information is displayed it will give you the amount of accrued vacation based on there hire date to today. I did have to add another column I highlighted it in yellow to calculate the number of months they have been working since the hire date as i couldnt put it all into one simple formula because it would be to many if statements.

Hope This Helps!!!

!forum.ozgrid.com/index.php?attachment/34309/

Re: Vacation Tracking Formula

Hello,

In the Spreadsheet it looks like you are trying to get the accrued amount of vacation time based on the month which if this is the case then the formula is right as it will take right now the month which right now is 10 then it minuses 1 which makes it 9 and 9*1.67 for instance would be the case in line 29 would be 15.03 which is correct. Now with this if it hit december it would never show there full amount of vacation time as it would take december month of 12 -1 which is 11 and would never calculate december fully the following forumla takes care of that by simply getting rid of the -1's

=IF(C29>=10,(MONTH(TODAY()))*$N$6,IF(C29>=5,(MONTH(TODAY())-1)*$N$5,IF(C29>=3,(MONTH(TODAY())-1)*$N$4,IF(C29>=1,(MONTH(TODAY())-1)*$N$3,(MONTH(TODAY())-1)*$N$3))))

Now from what your forum states it says your wanting the actual full amount of days that the people get a year if that is the case then the following formula will do that.

=IF(C9>=10,$M$6,IF(C9>=5,$M$5,IF(C9>=3,$M$4,IF(C9>=1,$M$3,$M$3))))

Hope This Helps!!!!

Re: Auto update of table for dynamic chart

Hello,

I have attached a copy of the document with the best thing that I can think of it works fine what I did was inserted a bit of VBA code to run when the Pivot Table Refreshes and places the data in without using formulas so that your Column E will remain blank and not show up on your chart this should suffice. Hope This Helps!!!

This was the code that was added to run with the pivot refresh and past the data into Column E.

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
Dim X As Integer
X = 3
Do
If ActiveSheet.Range("B" & X) > 0 Then ActiveSheet.Range("E" & X) = ActiveSheet.Range("B" & X)
X = X + 1
Loop Until ActiveSheet.Range("A" & X) = ""
End Sub

forum.ozgrid.com/index.php?attachment/34182/

Re: Function to print a single date for the week in following column.

Hello,

Here is a function that I have made to do what you are wanting I have had to do this myself for work to find deadline dates. Also I noticed just a quick tip might help you I see you did a formula in column D to get one number higher this can also be done by just typing 1 into the first cell of that row and then autofill down there is a small black box in the righthand corner of the cell when you click on it and then drag down and a box will appear when you finish dragging it click that little box and hit fill series and it will do that for you without the formula in there just a quick tip same for the dates in column A. Hope This Helps!!!

Function FindDateWeek(ByVal DateToFind)
Dim X As Integer
Do
If Format(DateToFind, "dddd") <> "Thursday" Then
    DateToFind = DateToFind + 1
Else
DateToFind = DateToFind
End If
Loop Until Format(DateToFind, "dddd") = "Thursday"
FindDateWeek = DateToFind
End Function

Re: Interdependent Relative Reference formulas on two different sheets - Do I Lock on

Hello,

I have taken a quick look at the problem and from what I am gathering you are deleting the row in the MultiSite Data Tab and it then messes with the formulas in column S on the Regulated Tarriffs Tab. If this is the case then you need to clear cell contents or simply hit the delete key rather than fully deleting the cells because this will cause the references in the cells to that particular row in the MultiSite Tab to (in a sense) no longer exist because they were deleted. Hope This Helps!!!

Re: Delete Dup tickets If The Value of the two or more duplicate tickets is lower tha

Copy the following code into your VBA and this should do what you want it to first sorts the data so that it can be easily identifiable on which ones match then it searches through the ones that match only and looks at the value in column B if it is less than 1800 it will be removed. Hope this Helps!!

Sub SortAndRemove()
    
    ActiveSheet.Range("A2").Select
    Selection.End(xlDown).Select
    X = ActiveCell.Row
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & X), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        .SortFields.Add Key:=Range("B2:B" & X), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange Range("A1:B" & X)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    I = 2
    Do
    If ActiveSheet.Range("A" & I) = ActiveSheet.Range("A" & I - 1) Then
        If ActiveSheet.Range("B" & I) < 1800 Then
            ActiveSheet.Rows(I & ":" & I).Select
            Selection.Delete Shift:=xlUp
        End If
    End If
    I = I + 1
    Loop Until ActiveSheet.Range("A" & I) = ""
    
End Sub

Re: Open Word File and GoTo bookmark

You were very close the following code will work for you be sure you have Microsoft Word Library referenced. Hope this helps!

Private Sub cmdGuide_Click()
 
    Dim wrdApp As Object
    Dim wrdDoc As Object
    Dim myFile As String
 
    myFile = "D:\Data\User Guide.docx"
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Open(myFile)
 
    wrdApp.ActiveDocument.Bookmarks("Census").Select
 
    Set wrdApp = Nothing
    Set wrdDoc = Nothing
 
End Sub

Re: Pull external data from same sheet in other workbooks

Hello,

This code will pull the data from the other files as specified above. Just copy this into your workbook and rename the files and paths in the code accordingly to match the filenames and paths that you are working with.

Sub GetDataFromFiles()
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Workbooks.Open Filename:="C:\TestProcedure 1.xls"
    ActiveSheet.Cells.Select
    Selection.Copy
    Windows("LabTestResults.xls").Activate
    Sheet1.Select
    Sheet1.Range("A1").Select
    ActiveSheet.Paste
    Workbooks("TestProcedure 1.xls").Close SaveChanges:=False
    
    Workbooks.Open Filename:="C:\TestProcedure 2.xls"
    ActiveSheet.Cells.Select
    Selection.Copy
    Windows("LabTestResults.xls").Activate
    Sheet2.Select
    Sheet2.Range("A1").Select
    ActiveSheet.Paste
    Workbooks("TestProcedure 2.xls").Close SaveChanges:=False
    
    Workbooks.Open Filename:="C:\TestProcedure 3.xls"
    ActiveSheet.Cells.Select
    Selection.Copy
    Windows("LabTestResults.xls").Activate
    Sheet3.Select
    Sheet3.Range("A1").Select
    ActiveSheet.Paste
    Workbooks("TestProcedure 3.xls").Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Re: macro to go back to previous worksheet

Try this it is a hyperlink it should suffice from what I gather you are trying to do.

=HYPERLINK("[Filename]Sheetname!A1","Go Back")

The Filename is the full name of the file for instance is i have a file called IdeaLog.xlsx and i had 3 sheets called sheet1, sheet2, and sheet3 the link would look like this

=HYPERLINK("[IdeaLog.xlsx]Sheet2!A1","Go Back")