Free Microsoft Excel 2013 Quick Reference

Vba paste to next empty row Results

I currently have the code below to code below to update a set of records on "MyList" based on the values on "Moved" Sheet. I need to adjust the VBA to move to the record on "Moved" if not found in the Sheet "MyList". It also needs to begin with Row 2 of "Moved".

Here is my current code:

Sub CopyMovedReportToMyList()
Dim Sheet1 As Worksheet, Sheet2 As Worksheet
ar = ActiveCell.Row
Dim Src As Range, Destrw As Long
Set Sheet1 = Sheets("MyList")
Set Sheet2 = Sheets("Moved")

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

On Error GoTo Abort
Columns("A:A").Select
Selection.NumberFormat = "General"
Range("A2").Select

Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Insert Move Report Date
Range("U1").Select
ActiveCell.FormulaR1C1 = "Date"
Dim LstRow1, LstRow2 As Long
LstRow1 = Sheet2.Range("A65536").End(xlUp).Row
With Sheet2
Range("U2" & ":U" & LstRow1).Value = InputBox("Enter the Date of the Move Report: ", "Update Account Basics...")
End With

Range("A2").Select

Do While Len(Range("A" & ar).Formula) > 0
' repeat until first empty cell in column A

Destrw = Sheet1.Range("A:A").Find(what:=Sheet2.Cells(ar, 1).Value, _
After:=Sheet1.Range("A1"), LookIn:=xlFormulas, Lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Row
With Sheet1
'update Moved to List Name, DD, DDC, Moved to List##
.Cells(Destrw, 78).Value = Sheet2.Cells(ar, 5).Value
.Cells(Destrw, 79).Value = Sheet2.Cells(ar, 6).Value
.Cells(Destrw, 80).Value = Sheet2.Cells(ar, 7).Value
.Cells(Destrw, 81).Value = Sheet2.Cells(ar, 20).Value

'inserts date for Report
.Cells(Destrw, 77).Value = Sheet2.Cells(ar, 21).Value

End With

ar = ar + 1 ' next row
Loop

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

'Autofilter
Sheets("MyList").Select
ActiveWindow.ScrollColumn = 74
Range("A:CE").Sort Key1:=Range("CC1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("CC2").Select

Exit Sub
Abort:
MsgBox Sheet2.Range("A3").Value & " was not found in column A of the sheet 'MyList'"
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

The macro autofilters for the criteria of "out of tolerance" in field 33, then copies the found rows to sheet2. Next it comes back to sheet1 and deletes the found rows. This part works well.

But when the are no rows with the criteria "out of tolerance" the macro copies the header row and moves it to sheet2.

I need the macro to do nothing if the criteria "out of tolerance" is not found on sheet1.

I am sure there is a simple solution. Could someone help with this situation.

Thanks in advance!

Sub FindMoveDelete()
'
' Find, move to new sheet then delete from old sheet
'
****Sheets("Sheet1").Select
****Const Criteria1 As String = "Out of Tolerance"
****'
****'Copy "Out of Tolerance" rows from sheet1
****'
****'****Need to fix, if no "Out of Tolerance" then it copies the header row. Need to code so if no "Out of Tolerance" then skip copy and paste
****With Range("A1")
********.AutoFilter Field:=33, Criteria1:=Criteria1
********Range("a2", Range("ah65536").End(xlUp)).SpecialCells(xlCellTypeVisible).Rows.Copy
****End With
****'****
****'
****Sheets("Sheet2").Select
****'
****'Paste "Out of Tolerance" to first empty row in sheet2
********Set rng = Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
****rng.PasteSpecial paste:=xlValues, _
******************** Operation:=xlNone, SkipBlanks:= _
******************** False, Transpose:=False
****Application.CutCopyMode = False
****'
****Sheets("Sheet1").Select
****'
****'Delete "Out of Tolerance" rows from sheet1
****With Range("A1")
********.AutoFilter Field:=33, Criteria1:=Criteria1
********Range("a2", Range("ah65536").End(xlUp)).SpecialCells(xlCellTypeVisible).Rows.Delete
****End With
****Selection.AutoFilter Field:=33

End Sub

Hello excel and vba experts

I have some code for an excel macro in vba version 6.0 that i am using for an excel 2000 workbook where one sheet (form) works as a form to fill in another sheet (tavela master) which acts as a database.

anyway, i am trying to create a macro so that when i save an entry the form sheet looks in the tavela master sheet to see if there is a match on the record number (in the A column) and saves there as an update if it matches and then if there is no match, saves it in the last empty row. this is a column to row copy so it has to be paste special to transpose. also i have a password on the sheet which i use to unprotect then reprotect. i have successfully done these two things separately but cannot combine them! i know not very much about visual basic code just what i have read here and so i am trying to make this code work.

please help! if possible thank you so much
ls

Code:

Sub Macro4()
Dim SearchCriteria As String
Sheets("form").Range("C1:C65").Copy
Sheets("tavela master").Unprotect Password:="secret"
SearchCriteria = Sheets("form").Range("C1").Value
With Sheets("tavela master")
For Each cell In .Range("A1", .Range("A65536").End(xlUp))
If cell.Value = SearchCriteria Then
Range(cell.Offset(0, 0), cell.Offset(0, 65)).Activate
PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
If cell.Value SearchCriteria Then
Range("A1").Select
varnbrows = ActiveCell.CurrentRegion.Rows.Count
ActiveCell.Offset(varnbrows, 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End If
Sheets("tavela master").Protect Password:="secret"
End If
Next cell
End With
End Sub

neither of the "ifs" above work but for example the code below did work and the second "if" worked by itself so i dont know what i'm doing wrong

Sub procurar()

Dim SearchCriteria As String

SearchCriteria = Sheets("form").Range("C1").Value

With Sheets("tavela master")
For Each cell In .Range("A1", .Range("A65536").End(xlUp))

If cell.Value = SearchCriteria Then
Range(cell.Offset(0, 0), cell.Offset(0, 65)).Copy
Sheets("form").Range("C1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End If
Next cell
End With
End Sub

Pull Column Data (Sheet3) from Master.xls and past to Column 4, Sheet4 of WorkingSS.xls

I'm assuming this would be done with VBA or a really exotic macro.

The Funky Part would be that the WorkingSS.xls file column data is being copied/pasted too (WorkingSS1.xls or WorkingSS2.xls ect) the file may be different every time so I would need an insert in macro or VBA to "Choose File Please..." then continue.

The Master.xls workbook has spreadsheet lets say "Sheet1" in which I need all the data in Column A (except the header or cell A:1) copied TO WorkingSS1.xls on Sheet4, Column B, but Column B already has about 6000 rows of info, so I need it copied to the very end of (A:6001 although it will be different everytime) or the first empty cell at the bottom of that column.

next another Column from Master.xls workbook lets say "Sheet1" again in which I need all the data in lets say "Column B" copied to the WorkingSS1.xls on Sheet4, Column F. Caveat this time is that the data needs to copied to the same row as the first copy/past. So it would be pasted into F:6001. Double caveat is that the Column F contains no other data except for what we are about to paste in.

I have several more steps of automation to be done here but this is the beginning and a big hump I need to get past. The rest I think I can do.

Thanks in advance for your help.

I have a workbook "MASTER".
Contained within it are 3 Worksheets:
"ABANDONED", "DW" and "DIMENSIONED"

All sheets have a Header Row.

I need to Cut (Not copy) all rows that contain the value "AB" in column "E" on Sheet "DW" and paste the entire row values and the formats of the cells onto Worksheet "ABANDONED" on the next empty row. (Under the header row).

TIA

Hi All,

I have a Customer table with a 4 to 6 digit customer code which represents the invoice address for the customer.
For the delivery address(es) (they used the same table, doh!?) and added a 3 digit suffix to the customer code (eg 351063 becomes 351063001 for delivery address one, and 251063002 for the second delivery address etc).

I want to create 2 separate tables in a database with a one to many relationship (ie a company table containing the invoice address only, and a table with all the delivery addresses for that compay.

This involves testing to see if the code is an invoice address code or not. If it is, I want to copy that row into another spreadsheet and delete the row in the original worksheet. Then, moving from the bottom to the top of the worksheet, do the same for the next row. If that next row is a company code, then I want it copied under the row that was previously pasted and so on.

Finally, I need a column added in the new spreadsheet, which will contain all the invoice customer codes (acting as a foreign key in this table), and the column has to be populated with the invoice code (that is, if the del address code is 351063001, the invoice code is 351063).

It has been a while since writing VBA and I just cannot get this happening.
Can someone please help me with some elegant code to do the job? This is what I have done so far..

Thanks in advance.
Bon


	VB:
	
 CommandButton1_Click() 
    getInvoiceCode 
End Sub 
 
Function GetLastRow() As Double 
    Dim Z As Range 
     
    Set Z = Sheets("RawData").Cells(1, 1).EntireColumn.Find("*", SearchDirection:=xlPrevious) 
    If Not Z Is Nothing Then 
        GetLastRow = Z.Row 
    End If 
End Function 
 
Sub getInvoiceCode() 
    Dim length As Integer 
    Dim myString As String 
    Dim p As Integer 
     
    For p = GetLastRow To 1 Step -1 
        myString = Sheets("rawdata").Cells(p, 1).Value 
        length = Len(myString) 
        If length < 4 Then 
            Sheets("rawdata").Row(p).Select 
            Sheets("rawdata").Row(p).Copy 
             
             'If it is the first row copied,
             'copy the row from Sheets("rawdata")
             'into the second row in Sheets("newdata")
             'If it is not the first row copied,
             'copy the row from Sheets("rawdata")
             'into the next empty row
             'Delete the row from in Sheets("rawdata")
             'Finally, move to the next row
             
        End If 
         
    Next 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi Guys,

Yall have been so great in the past helping me figure out VBA. I am trying to learn more on my own but am confused by the result I am getting from my code.

I am trying to copy a range D10:K509 to the next empty column on the same worksheet. It might even overlap with the specified range (IE might have columns 10-20 filled, so would want column 21 to be the destination.)
Since the data range can vary, I put in a search function to look for nonempty cells.
When I run the macro, it seems that it copies the values to the very end of my spreadsheet and one column over. I have attached the code if anyone could help please.


	VB:
	
 lease = Range("d10:d509").Find("", LookIn:=xlValues, lookat:=xlWhole) 
 
For Each d In Range("d10:k509") 
    If Not IsEmpty(Cells(d.Row, lease.Column)) Then 
        .Range("C10:k509", .Cells(.Rows.Count, "D").End(xlUp)).Copy 
        Range("d10:k509").End(xlDown).PasteSpecial xlValues 
        Application.CutCopyMode = False 
    End If 
Next d 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Good afternoon!
I have run across an issue while trying to automate some documents I use at work. What I would like to know how to do is this: How can I update information in rows and columns of an embedded excel table using only VBA?

I have the table embedded in a word document, and Im stuck at the point of passing some variables that are being defined on the fly by a loop. I need to open the table (without activating or selecting it, since that will interfere with the search word is doing to find the lines that will eventually contain XForce, YForce, etc), find the last empty row in that table, and paste those variables as the loop cycles through into the next empty row of that table. Once the loop ends, I also would need to close out of the table as well. Here is the code I currently have:


	VB:
	
 Shape 
Dim TableObj As Object 
Dim EntireLoadLine As String 
Dim wddoc As Word.Document 
Dim ZMoment As String 
Dim YMoment As String 
Dim XMoment As String 
Dim ZForce As String 
Dim YForce As String 
Dim XForce As String 
 
 ' ....have other code already working above; will only include section that gives me an issue
 
Do 
    For i = 0 To 4 
        Selection.HomeKey Unit:=wdLine 
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend 
        EntireLoadLine = Selection 
        Application.ScreenUpdating = True 
         'MsgBox "The Computer Currently Sees: " & EntireLoadLine
        ZMoment = LTrim(Right(EntireLoadLine, 11)) 
        YMoment = LTrim(Mid(EntireLoadLine, 54, 11)) 
        XMoment = LTrim(Mid(EntireLoadLine, 43, 11)) 
        ZForce = LTrim(Mid(EntireLoadLine, 32, 11)) 
        YForce = LTrim(Mid(EntireLoadLine, 21, 11)) 
        XForce = LTrim(Mid(EntireLoadLine, 10, 11)) 
         
        For Each oShape In wddoc.Shapes 
            If oShape.Type = msoEmbeddedOLEObject Then 
                If oShape.OLEFormat.ProgID = "Excel.Sheet" Then 
                     'If oShape.OLEFormat.ProgID = "Excel.Chart" Then
                    Set TableObj = oShape.OLEFormat.Object '< THIS LINE GIVES ERROR "Method 'Object' of 'object 'OLEFormat'
failed"
                     
                     'Here is where I would have it set individual cells in the table = XForce, YForce, ZForce, and so on...
                     
                    TableObj.Activate 
                     'End If
                End If 
            Next oShape 
             
            Application.ScreenUpdating = False 
            i = i + 2 
            Selection.MoveDown Unit:=wdLine, Count:=i 
        Next i 
    Loop Until Left(EntireLoadLine, 2)  "J" 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
I am using Word 2007, and Excel 2007. I have also tried Dim'ing 'TableObj' as Excel.Worksheet, Excel.Workbook, ect, to no avail, and I cannot find out from anywhere online what to do once you get the OLE object recognized (the part where the strings will get pasted into an empty row in the embedded table everytime the loop comes around again). I appreciate any help you can give me on this as I have a TON of documents I have to do this for!!!!

I am still new to VBA so please excuse what might be a confusing description.

I have a routine which works fine but I would like to improve it (and my VBA knowledge) by a for Next loop.

The code generates a range of values at ("B23:Q23") at the first[Activerate] and drops this into the top of my sheet ("CareTbl28Calx"). After each change to the [Activerate] the new values and their formatting are pasted 25 rows (or 26 rows if I miscounted) below the previously pasted range. (btw I tried looking at some of the code exambles to find the next empty row but found it very confusing particuarly as I am allowing a couple of rows blank between each set of results)

The [ActiveRate] as can be seen from the code always increases by 0.5 from a start value of -2 to the final value of 3.0 .

I've only a very basic understanding of loops so whilst I've played around with some code I realise now I am in need of some help.

Thank you all

Application.ScreenUpdating = False
With Sheets("CareTbl28Calx")
                .Select
    [ActiveRate] = -2
    Sheets("CareTbl28Calx").Range("B2:Q23").Copy
    
    
    Range("B27").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B27").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    [ActiveRate] = -1.5
    Range("B52").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    [ActiveRate] = -1
    Range("B77").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    [ActiveRate] = -0.5
    Range("B102").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    [ActiveRate] = 0
    Range("B127").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        
    [ActiveRate] = 0.5
    Range("B152").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
        
    [ActiveRate] = 1
    Range("B177").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    [ActiveRate] = 1.5
    Range("B202").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    [ActiveRate] = 2
    Range("B227").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
   
    [ActiveRate] = 2.5
    Range("B252").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    [ActiveRate] = 3
    Range("B277").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Application.CutCopyMode = False
    
    [ActiveRate] = Format(UserForm1.cbDiscRates, "standard")
    
    
    Range("a471").Select
    ActiveWindow.ScrollRow = 2
    Application.ScreenUpdating = True
    
    End With


Hello: I am trying to add data from sheet 1 to a table in sheet two. The reason is that I am trying to generate an automatically updated pivot which is possible with a table. The data in sheet 1 is being populated from another source . I am trying to get data from sheet 1 to keep pasting in a table in sheet 2 in the next empty row. Then I have a pivot in sheet 3 which will auto populate the additions. I am using excel 2007.

Thanks in advance for your help

Hi guys, I could do with some help with VBA Code

I have a excel file in which data gets inputted, and then based on this data excel will match some text in the cell to the right from a mapping tab. If excel can't find a match for this data, I get an #N/A error. So I want to search column V and If I get this error, I want to copy the data in the cell to the left of the #N/A error (Column U) and paste it into the first empty cell in column A of another tab.

So basically, I want to search column V for #N/A Errors, if there is an error, copy the cell to the left of the #n/a error and paste it into the first empty row of another tab.

Thanks guys, hugely appreciated!

Looking for some help with VBA code to do some search and calculations.

I have 4 Columns (A-B-C-D) for sake of argument. I have raw numbers in
Columns A & B and calculations in C & D. There may be anywhere from 10 to
500 Rows. Possible more. A & B may or may not be “color” filled. A with a
Lime Green and B with a Red fill.

What I need to do is search Column A from top down until I find a Green
fill. After I locate the fill, I then need to move to Column B and search
for a Red fill.

If the cell in Column B adjacent to the Green fill has a Red fill, I need to
then subtract Column B from Column A and return the results in Column C. If
there were no Red fill, the search would continue down B until a Red fill is
found and then subtract the Red cell from the Green cell and return the
results in Column D.

After subtracting the Red from the Green, the next step would be to drop one
Row and return to Column A in search of a Green fill. If nothing is found,
the search should continue down Column A until a Green fill is located. When
located, I then need to subtract the previous Red fill from Column B, Row ‘n’
from the new found Green fill Column A, Row ‘n’ and return the result in
Column D in the same Row as the Red fill.

If there is a Green “and Red fill in the same Row, the Red in Column B gets
subtracted from the Green in Column A; however, the Green would not be
subtracted from the adjacent Red. Again, the search would need to continue
down Column A until the next Green fill is located.

The search/calculations should stop once an empty cell is reached in Column
A or B.

The following is a sample/example from one of my spreadsheets. Figures in
Column C are calculated based on a Green fill in A and those in D from a Red
fill in B. (Copy/Paste did not include the color fill)

A B C D
42.43 41.35
41.72 41.05
41.35 40.82
41.16 40.56 0.81
41.48 40.88
41.64 40.35 (2.40)
42.09 41.18
42.29 41.67
42.75 42.05 0.70 (0.77)
42.53 42.22
42.63 41.67
42.82 42.15 1.30
42.75 42.07
42.46 42.00
42.38 41.85
42.40 41.64
41.98 41.52 (1.01)
42.05 41.59
42.53 41.93 2.09
42.19 41.80
42.24 41.68
42.03 40.90
41.08 40.69
41.01 40.44 (2.29)
42.04 40.88
42.11 41.64
42.45 41.93
42.73 41.32 3.41
41.62 40.60
41.05 40.28
40.99 40.32
40.65 40.26
40.94 39.32

Any help with some code would be greatly appreciated.

Thanks
SHD

--
SHD

Hi everyone

I am trying to create a data entry form in excel, i am doing this on a worksheet rather than a user form as i want to use cascading lists which i cant for love nor money get to work on a user form. (without huge amounts of code that is beyond my skill level)

So this is what i have:

i have some named cells, for example, Name is cell B4 DOB is cell F6 and so on, what i am after is vba code i can assign to a command button that will:

1: copy each of the named cells (all in about 20) on sheet 1
2: Paste this to the next available row so if it was empty except headers A2 paste Name B2 paste DOB and so on along row 2
3: empty the values in the named cell on sheet 1 and basically reset the form.
All of this without leaving sheet 1

To add one further thing in, i have a few checkboxes so what do i need to do differently to get either the true or false value from the check box to paste into C2 on sheet2.

so the data in Sheet 2 would be Nick (A2) 16/01/82 (B2) True (C2)

Thanks All

Nick

12/7/7

PROJECT: Workorder Database

I'm trying to write some code for a simple database and am needing some of your VALUABLE help. I know very little about VBA and will be learning this as I go, please be patient.

I'd really like to do this in 'baby steps'. Thanks

I've formatted a spreadsheet for the data to be collected, it looks like a form.
Just some cells with data, i.e. name, address... (actually several sheets of data)

I want to take the data from the form and have a button append it to the next empty row of a different sheet.

I think I'll be using some type of automated copy/paste from there.

Please remember 'baby steps'.

If someone already has some code that would be fine, if not then...

I had the basics fully working, but have been running into problems as I refine the macro

Here's some code I wrote, it did look a whole lot better, but during the fixes, attempted fixes and additions it got disorganized...

My problem now is step 4a. copy WO# back to Woform.xls sheet Form cell j30.
I cant get it to re-select the first wkbk, Woform.xls and paste the WO# , (you can see my attempts)
Then I want it to go back to the Wodb.xls to complete the macro.

THANKS in advance, Phil

Sub
AppendWOdb()
'
' AppendWOdb Macro
' Macro recorded 12/5/2007 by Phillip O. Hasty
'


'   DONE 1. Copy job details from Woform.xls sheet CodeTables,
'   DONE 2. open WOdb,
'   DONE 3. find first blank line
'   DONE 4. add WO# and date/time,
'   4.a  copy WO# back to Woform.xls sheet Form cell j30, go back to WOdb
'   DONE 5. Paste details to that line,
'   DONE 6. Save and Close WOdb
'
'

'
'
'

    ' 1.2.3.Change sheet from 'form' to 'codetables', Copy details, Open 'WOdb.xls',
    ' find first blank line
    
    Sheets("CodeTables").Select
    Range("A1").Select                 'good starting point
    Selection.CurrentRegion.Select     'selects the first line which has the data
    Selection.Copy                     'copies the data
    'Workbooks.Open Filename:="Z:My DocumentzWorkOrderFilesWOdb.xls"
    Workbooks.Open Filename:="Clinton-dccommonWorkOrdersWOdb.xls"  'opens WOdbxls
    Range("A1").Select                 'good starting point
    Selection.End(xlDown).Select       'selects a line down
    Selection.End(xlDown).Select       'selects a line down
    ActiveCell.Offset(1, 0).Range("A1").Select 'selects 1 cell below
    
    
    '4. add the next WO#
    ActiveCell.FormulaR1C1 = "=R[-1]+1" 'adds 1 to the number above this cell
    
    
    '4a. put wo# on form
    Selection.Copy
    Workbooks("WOform.xls").Worksheets("Form").Activate
    'Workbooks("WOform.xls").Select
    'Workbooks("WOform.xls)".Activate
    'Sheets("Form").Select
    'Range("j30").Select
    'Selection.PasteSpecial (xlPasteValues)
    'ActiveSheet.Paste Destination:=Worksheets("Form").Range("j30")

    'before proceeding, I need to go back to WOdb and the active cell


    '4. add 'date of entry' (one cell to the right of WO#)
    ActiveCell.Offset(0, 1).Select
    Dim Today
    Today = Now    ' Assign current system date and time.
    ActiveCell.Formula = Today

    
    '5. move 1 cell right and paste
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False

    
    
    'make Range = db
    Selection.CurrentRegion.Select
    Selection.Name = "db"
    

    
    
    'load db into form
    'Selection.Copy
    'activate Form file
    'copy to sheet FORMDB
    
    
    'go back to WOdb
    
    'save changes and close to WOdb
    ActiveWorkbook.Close SaveChanges:=True
    Range("A1").Select


    'go back to 'form' cell a1 for next WO
    Sheets("Form").Select
    Range("A1").Select


'
End Sub


Hello - - I have a question that I don't know if it's possible. I'm looking to copy the content of emails coming from the same email address (about 5 to 10 per day) and paste them into an Excel file. The goal is to compare records counts...day to day to day...and then flag ones where the variance is plus or minus x number of records.

The email body is very basic, 4 lines: Date, Filename, File size and Record Count.

Here's an example of the message:

Date: Thu 15 Sep 2011 09:01:09 AM EDT
Filename: AUTO_C12345_20012356874.dat
File size: 162887
Record Count: 475

Is there some starting code someone might have to share that would get me started?

As I think of my question, I think I'm about to make it a bit more complicated. In addition of puting this data into a specific excel file, the excel file would be the same day after day, where the newest data is placed in the first empty row. The data elements of the email: Date, Filename, File Size and Record Count become headers, so I think theres some sort of transpose thing I would need to consider as well. The emails should also be from the same address, but the ones that are unopened and ignore the already opened emails. Again, any thoughts and/or suggestions would be great.

Wasn't sure if should have marked it solved or not - - I moved on and tried something else. Basically I took the 4 lines from the email and pasted them into a spreadsheet - - from there I ran and recorded a series of steps like: text to columns, copy/paste special/transpose, moved cell values to final columns and rows, deleted empty rows, sorted the file by filename...etc. I put all my recorded code together and ran them all as one macro and it did what I needed. The only thing I do manually is copy the original email and paste it into this excel file. Then I run my code, then repeat. So it's fast enough for my situation.

If anyone is interested, here is my code from Excel:

Sub DataExchangeEmails()

' Section A - this section will format via text to columns plus uses copy/paste special to Transpose for columns
'             Saves the group of data to the 50th row

 Selection.TextToColumns Destination:=Range("I1"), DataType:=xlFixedWidth, _
        OtherChar:="_", FieldInfo:=Array(Array(0, 1), Array(15, 1)), _
        TrailingMinusNumbers:=True
    Range("I1:L4").Select
    Selection.Copy
    Range("A50").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A49").Select
    Range("H1").Select
    
' Section B - this will remove or delete any blank rows between row 50 and the last blank row above

Dim bye As Long

With ActiveSheet
    For bye = .Cells.SpecialCells(xlCellTypeLastCell).Row _
        To 1 Step -1

        If WorksheetFunction.CountA(.Rows(bye)) = 0 Then
            ActiveSheet.Rows(bye).Delete
        End If

    Next
End With

' Section C - this deletes the newest data exchange entries header row, searches for DATE: in column A and deletes it,
starting in A2
 
Dim x As String
Dim b As Long
x = "Date:"
y = Cells(Rows.Count, 1).End(xlUp).Row
        For b = y To 2 Step -1
            If InStr(Cells(b, 1), x) > 0 Then ' the number here represents the column 1 being col A, 2 would be col B
            Rows(b).EntireRow.Delete
            End If
        Next b
MsgBox "Delete Complete"

' Secion D - this removes the original copied data values from the email that was copyed in I1.

Range("I1:L4").Select
    Selection.ClearContents
    
' section E - This resorts the rows by Filename

Range("g1").Select
    Range("A1").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B:B") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub


Hello everyone.

I have a following problem with excel macro:

Every day I have to copy data from the first row (A1:DB1) in to first empty row in the sheet (for example A25:DB25).

Then I have to clear the data for the previous day in the next-to last row (A24:DB24 in this example). But , I have to leave the the data in a cell A24 i.e. I have to clear the data only from B24:DB24.

I am only a begginer with VBA so I looked on the net I found this macro:

 Worksheets("Daily data").Range("A1:DB1").Copy
    Worksheets("Daily data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=True, Transpose:=False
        Application.CutCopyMode = False
        
         
    Worksheets("Daily data").Cells(Rows.Count, "A").End(xlUp).Offset(-1,
0).EntireRow.ClearContents
However, this macro deletes everything from next-to-last row (inlcuding the data in column A).

How can I modify it so it would clear data only from the B24:DB24 range ?

Any help is welcome.

With Regards,

Eriol

Good day to you all,

I'm an new to this forum and still kind of a VBA noob. I've searched the internet for the past 24 hours to help me find a macro that will filter my mastersheet on each new day and copy the data for that day to a new sheet (named that particular day).

I did find a macro that can do this trick for every new month, but I don't get it to do this for every day. This is probably a minor adjustment so i hope someone here can help me with this.

I have a mastersheet in which many new invoices are added every day. At the end of the week i want invoices with the same date to be copied to a separate sheet. After this the next step will be to add two standard lines and save the sheet as a txt file.

below the vba code I found for doing this for every new month.

I would be very gratefull if someone knew how to do this for every new day!

Sub CreateMonthlySheets()
Dim lastRow, mMonth, tstDate1, tstDate2, shtName, nxtRow

On Error Resume Next

'Make a copy of the data sheet and sort by date
  Sheets("Sheet1").Copy After:=Sheets(1)
  Sheets(2).Name = "SortTemp"
   With Sheets("SortTemp")
      lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
       Rows("2:" & lastRow).Sort Key1:=Range("A2"), Order1:=xlAscending
       
'Using SortTemp Sheet, create monthly sheets by
'testing Month and Year values in Column A

'Loop through dates
         For Each mMonth In .Range("A2:A" & lastRow)
          tstDate1 = Month(mMonth) & Year(mMonth)
          tstDate2 = Month(mMonth.Offset(-1, 0)) & Year(mMonth.Offset(-1, 0))
          
'If Month and Year are different than cell above, create new sheet
           If tstDate1 <> tstDate2 Then
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
            
'Name the sheet based on the Month and Year
            ActiveSheet.Name = MonthName(Month(mMonth)) & " " & Year(mMonth)
           End If
         Next
  On Error GoTo 0
  
'Loop through dates, copying row to the correct sheet
     For Each mMonth In .Range("A2:A" & lastRow)
'Create sheetname variable
      shtName = MonthName(Month(mMonth)) & " " & Year(mMonth)
'Determine next empty row in sheet
      nxtRow = Sheets(shtName).Cells(Rows.Count, 1).End(xlUp).Row + 1
'Copy Data
      .Range(mMonth.Address).EntireRow.Copy Destination:=Sheets(shtName).Cells(nxtRow, 1)
     Next
   End With
'Delete SortTemp sheet
  Application.DisplayAlerts = False
    Sheets("SortTemp").Delete
  Application.DisplayAlerts = True
End Sub


I have started a code that I thought would perform at least close to what I'm looking for, but i just can't seem to get the hang of tags and labels. Any help would be appreciated.
I have just started working with VBA and macros in excel so I know it will look ridiculous to most.

Sub
automove()

Set activecell = range("I3:I21,I26:I40")

ActiveWorkbook.Sheets("Initial Log").Activate

If IsEmpty(activecell) = False Then

    range(activecell & Row).Select
    Selection.Cut
    End If
    
    ActiveWorkbook.Sheets("Total Month Log").Activate
    Do
    If IsEmpty(activecell) = False Then
    activecell.Offset(1, 0).Select
    Loop Until IsEmpty(activecell) = True
    ActiveSheet.Paste
        
    Application.CutCopyMode = False

End Sub
This is what I'm looking for:
When there are initials put in column "I" in both sections on the initial log page, I want (if non 2410 item) the item to be moved from the initial log page to the next empty row on the total month log. If the item is a 2410 item I want it to be cut and pasted in the next empty row on both to the 2410 log and the total month log.

I will also attach a copy of the workbook.

Thank you.

Hi,

I have done a search but I keep getting a eroor for results so I hope someone can post me a quick helful reply.

I have a qorkbook. I will already have the row highlighted, then activate this macro

Sub
Tran2Hist()
'
' Tran2Hist Macro
'
    Selection.Copy
    Sheets("HistRec").Select

    ' Code to find the next empty cell in column A so I can paste in the data on the clipboard  

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("db").Select
    Range("D19").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Save
End Sub
I need a quick bit of code to locate the next empty cell in column "A" so I can then continue with the code by pasting data in.

Thanks for the help in advance.

I have very little experience with VBA but I have managed to get a few items programmed on the workbook I'm attempting to create. I have hit a wall though with my latest button.

History of the workbook.

My user "form" page looks like a check. The idea is that the user selects a project number and a vendor from drop down lists. They then enter a requisition number and an amount for the transaction (may be positive or negative). I'm trying to create a button that once this information is filled out the user clicks the "Authorize" button and the vendor, requisition #, and amount is copied to the worksheet whose name equals the project number on the next empty row. (Think when you write a check and transfer the information to the register; I know who uses checks anymore). The one other criteria would be that on my transaction sheet I have a debit and credit column if the amount field is <0 it would paste to the credit column if the amount is >0 it posts to the debit column. After the paste is complete I need it to clear "user filled" cells on the form.

I'm sure there are a lot of questions I'll have to answer to get where I need to go, but any help would be greatly appreciated.

Thanks,
Will