Posts by hugletank

hugletank · Mar 21st 2013

I Have this code which I pieced together from various sources. It copies a row from Sheet1 to another worksheet named sum. It works fine but in the destination worksheet it doesnt paste data into row 1, instead starting at row 2. It means I can put a heading into row 1 on the destination sheet. I cant work out tho , what in the code tells it to choose row 2 instead of row 1? I know its this bit but cant see why it starts at row 2

Code

wksDest.Range("A" & Rows.Count).End(xlUp)(2)

Heres the full code;

Code

Sub TestCode()Dim c As Integer
Dim wksSource As Worksheet
Dim wksDest As Worksheet




Set wksDest = ThisWorkbook.Worksheets("sum")




Finalrow = Worksheets("Sheet1").Range("b65536").End(xlUp).Row




For c = 1 To Finalrow




x = Range("a" & c).Value




If x = "test" Then
    
    Range("A" & c).EntireRow.Copy wksDest.Range("A" & Rows.Count).End(xlUp)(2)




End If




Next c




End Sub

Display More

hugletank · Feb 21st 2012

Re: Summarise data from multiple sheets based on dates

With some help I have this code now which does almost everything I want.

I now only need help in determining if the date in column A is a specific number of workdays before todays date. Can someone provide some help with this?

Heres my current code.

Code

Sub TestCode()Dim c As Integer
Dim x As String
Dim wksSource As Worksheet
Dim wksDest As Worksheet




Set wksDest = ThisWorkbook.Worksheets("sum")




For y = 1 To 4




Set wksSource = ThisWorkbook.Worksheets("Area " & y)




wksSource.Select




Finalrow = Cells(Rows.Count, 1).End(xlUp).Row




For c = 3 To Finalrow




x = Range("A" & c).Value




If x < Range("a2").Value Then
    
    Range("A" & c).EntireRow.Copy wksDest.Range("A" & Rows.Count).End(xlUp)(2)




End If




wksDest.Range("A" & Rows.Count).End(xlUp)(1, 4).Value = "Area " & y




wksSource.Select




Next c




Next y




End Sub

Display More

hugletank · Feb 20th 2012

Re: Summarise data from multiple sheets based on dates

So I Managed to piece this code together which does most of what I want for an individual sheet.

Could anyone help me to adapt the code to do the same for all of the 4 areas and also into column D what area the data came from?

Code so far

Code

Sub test()
Dim c As Integer
Dim wksSource As Worksheet
Dim wksDest As Worksheet




Set wksSource = ThisWorkbook.Worksheets("Area 4")
Set wksDest = ThisWorkbook.Worksheets("sum")




wksSource.Select




FinalRow = Cells(Rows.Count, 1).End(xlUp).Row




For c = 3 To FinalRow
wksSource.Cells(c, 1).Select
If ActiveCell.Value < wksSource.Range("a2").Value Then
    wksSource.Cells(c, 1).Select
    ActiveCell.EntireRow.Select
    Selection.Copy




    wksDest.Select
    NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(NextRow, 1).Select
    ActiveSheet.Paste
End If




wksSource.Select




Next c




End Sub

Display More

hugletank · Feb 19th 2012

I have a workbook that contains four sheets. Each sheet is for a specific area, but the data on all the sheets is similar.

I would like to summarise the data from all the sheets onto a new sheet that can be viewed and printed, but cannot be altered by the user. The only time the sheet will change is based on changes to the other four sheets. Hope that made sense!!

I would like to use the date as the 'source' data so that any row that has a date of more than 2 working days ago (monday to Friday) will appear on the summary sheet.

Can anyone help?

Thanks in advance.

hugletank · Jan 3rd 2012

Re: Creating a rolling balance for list of figures

Thanks for the assistance. michaelnicolas. I was expecting to have to use some sort of VB code, nice simple solution.

hugletank · Jan 3rd 2012

Re: Creating a rolling balance for list of figures

I have uploaded an example. The third column I have added shows the 'balance'. I would like the rolling figure from this column to display in any cell, for example, D1. I can then hide the column with the formula in and this one cell will show the running balance.

hugletank · Jan 3rd 2012

I am trying to create a spreadsheet with 2 columns of data. Column A will show Cr or Db using data validation. Column B will be either one or several Cr followed by only one Db. The idea is to key the Cr amounts, and then the corresponding Db amount will 'balance it out. All figures in this column will be positive.

So for example, in column A there will be 3 cells with Cr, there corresponding amounts in column B being 10 (totaling 30). The 4th cell in column A will then be Dr, and the 4th cell in column B will be 30, and so they 'balance'

I would like to have a cell which shows the totals in a rolling format, showing how much is left, and then if the sets of data 'balance'. So from my example, the cell would first show 10 then 20 then 30 and finally balanced.

Hope this makes sense.

Thanks in advance for any help.

hugletank · Sep 11th 2011

Re: Why does this code not work every time?

Thanks for the help. The 'tab' is just the keyboard tab button to move from textbox1 to textbox2.

I have attached a copy of the file so you can have a look. As I have said, I am new to the whole VBA thing so its not great

You can check if the email sends everytime for you. I have read that the SendKeys function is a bit unreliable. If you cant see why I am having these issues I may just put in a msgbox to tell the user to press send when the email pops up.

Thanks again

hugletank · Sep 11th 2011

Re: Why does this code not work every time?

It is my own userform, but all it does is gets some user input. There are 3 fields, which I transfer to cells in a worksheet and I use the keyboard tab to move between the fields. On random occasions the keyboard tab key doesnt move between the fields, but other times it does.

I am still learning VB in excel, a lot of what I have showed you has been borrowed and I have tweaked it for my needs.

hugletank · Sep 11th 2011

Re: Why does this code not work every time?

Thanks for the help so far macarius.

I seem to have isolated the problem to coincide with the userform I have created not working correctly.

When I fill the details in on the userform, I use the tab button to move from field to field. When the tab button works the code works. Sometimes, however, the tab button doesnt move to the next field, but tabs along the existing field. When the tab buttons doesnt move from field to field, the email doesnt send.

Any ideas why this might be?

hugletank · Sep 11th 2011

I have the following code to obtain info from a userform and send an email with the details. The issue I have is that from time to time, the email will not send and just sits there waiting while the rest of the code completes, but the email never sends. Does anyone have an idea why this might be, or have any suggestions as to how to make sure it sends everytime?

Code

Sub Mail_Fault_Number()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim eAddr As String
Dim eSubject As String
Dim response As String


Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Sheet1").Range("a1:b3").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "There is no data to be sent." & vbNewLine & "Please correct & try again.", vbOKOnly
Exit Sub
End If
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
    .To = "sxxxxxxxxco.uk"
    .CC = ""
    .BCC = ""
    .Subject = Sheets("Sheet1").Range("a5").Value
    .HTMLBody = RangetoHTML(rng)
    '.Send
    .display
End With
On Error GoTo 0


With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
Application.Wait (Now + TimeValue("0:00:2"))
SendKeys "%{s}", True
response = MsgBox("Your email has now been sent." & vbNewLine & vbNewLine & "Do you wish to print a Yellow Tag?", vbYesNo)
If response = vbYes Then
MsgBox ("Please select your printer, from the following selection.")
Application.Dialogs(xlDialogPrinterSetup).Show
Application.ScreenUpdating = False
Sheets("Sheet2").Visible = True
Sheets("Sheet2").Select


ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWindow.SelectedSheets.Visible = False




Sheets("Fault Reporting").Select
MsgBox "Your 'Yellow Tag' label is now printing." & vbNewLine & vbNewLine & "This file will now close."
With Application
   .DisplayFullScreen = False
   .CommandBars("Worksheet Menu Bar").Enabled = False
End With


ActiveWorkbook.Close
ElseIf response = vbNo Then


MsgBox ("This file will now close.")
With Application
   .DisplayFullScreen = False
   .CommandBars("Worksheet Menu Bar").Enabled = True
End With
ActiveWorkbook.Close SaveChanges:=False


End If




End Sub


Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook


TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


rng.Copy


Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With


With TempWB.PublishObjects.Add( _
    SourceType:=xlSourceRange, _
    Filename:=TempFile, _
    Sheet:=TempWB.Sheets(1).Name, _
    Source:=TempWB.Sheets(1).UsedRange.Address, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
End With


Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close


RangetoHTML = Replace(RangetoHTML, _
           "align=center x:publishsource=", _
                "align=left x:publishsource=")
                
                
TempWB.Close SaveChanges:=False


Kill TempFile


Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing


End Function

Display More

Any help would be greatly appreciated.

Posts by hugletank

Copy row from one sheet to another - but paste in row 1

Summarise data from multiple sheets based on dates

Summarise data from multiple sheets based on dates

Summarise data from multiple sheets based on dates

Creating a rolling balance for list of figures

Creating a rolling balance for list of figures

Creating a rolling balance for list of figures

Sending email with VB SendKeys - intermittently wont send

Sending email with VB SendKeys - intermittently wont send

Sending email with VB SendKeys - intermittently wont send

Sending email with VB SendKeys - intermittently wont send