Posts by creativespace

Re: Sum extra hours worked before today and subtract leave hours based on text string

Hi NBVC... thanks for taking the time to help. I thought I was close a couple of times, but seeing your solution I realise I was nowhere near. I got hung up on trying to make vlookup work. I'm gonna spend sometime trying to figure out your approach. Thanks again... greatly appreciated

Hi All, I hoped someone may be able to help with the following. I want to calculate the running total of hours worked, day by day, above those contracted and then subtract set hours based on leave type which is a text string. The basic timesheet is on sheet1 and the lookup table of set leave hours is on sheet5. I have attached the workbook that hopefully gives enough information. Thanks in anticipation of any support

Re: Copy nonblank cells from one sheet and paste in same cell position in another

Hi Mawhrin / SO, I stripped all of the formats out of sheet 1(the range to be copied) and Mawhrins code below worked and executed in about 20 secs, so it seems there was an issue with the worksheet. Thanks to you both for taking the time to help :smile:

Private Sub CopyNonBlankCells()


    Dim cell As Range
    Dim strAddress As String
     'Assuming the required range is selected before running the macro
     
    For Each cell In Selection
        If Not cell = vbNullString Then
            strAddress = cell.Address
            cell.Copy Sheets("Sheet2").Range(strAddress)
        End If
    Next cell
End Sub

Re: Copy nonblank cells from one sheet and paste in same cell position in another

Hi SO / Marhwin, I have stripped down the file dropping it from 702kb to 18kb to upload it. In doing so I noticed that Marhwins first solution works with the smaller range (G5:Z30) but freezes the worksheet on the full range (G5:NF303). Any thoughts you guys might have will be gratefully received :smile:

Re: Copy nonblank cells from one sheet and paste in same cell position in another

Hi All, for info I've just noticed that the sheet1 range applies the cell fill colour using multiple conditional formats, so the cells to be copied are linked to conditional format formulas... I'm not sure if that changes the vba requirement... regards :0ops:

Re: Copy nonblank cells from one sheet and paste in same cell position in another

Hi SO, thanks again for trying but the same result as before, only works for the first couple of rows. If I highlight the range in sheet1 and try Go To Special, and select Constants it does select the required cells so I am sure they are constants. The original method in the first post did copy all the cells, but it pasted them all together at the top left of the range in sheet2, as opposed to in the same cells as on sheet1. Any other thoughts would be most welcome :smile:

Re: Copy nonblank cells from one sheet and paste in same cell position in another

Hi Mawhrin, blue circle of death again I'm afraid. I appreciate it is impossible with one arm tied behind your back, but I thank you for trying... Are there any other possibilities :x

Re: Copy nonblank cells from one sheet and paste in same cell position in another

Hi SO, thanks for taking the time to help, I really appreciate it. When I tried your code it only copied and pasted a few of the non blank cells from sheet1 to sheet2 over the first couple of rows, nothing else copied over???

Re: Copy nonblank cells from one sheet and paste in same cell position in another

Hi Mawhrin, thanks for taking the time to respond, it is most appreciated. I tried your recommendation on a small sample of data in a test sheet (B5:P20) and it worked great. However, when I try it on the full data range G5:NE303 it just freezes with the blue circle of death. Unfortunately I cannot upload the actual worksheet due to sensitive data and all, any ideas :x

Hi all, I was hoping someone may help with the following. I wish to copy the nonblank cells (containing text and fill colour) from a range on sheet1 and paste them into the same range and cell position on sheet2. The range on sheet2 currently has information that I need to keep, but I want the nonblank cells from sheet 1 to overwrite their corresponding cells in sheet2, without affecting the rest of sheet2. The code I have tried is below but it doesn't do exactly what is required. Thank you in anticipation of any assistance :smile:

Sub Copy_NonBlank_Cells()
On Error Resume Next
Sheets("Sheet1").Range("B5:P20").SpecialCells(xlCellTypeConstants, 23).Copy
Sheets("Sheet2").Range("B5:P20").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
On Error GoTo 0
Application.CutCopyMode = False
End Sub

Re: Automatically enter text in cell when due date in other cell is exceeded by 272 d

Hi Cytop, thanks again for taking the time to reply. Thats my lesson learnt for the day... I'll sleep sound tonight

Cheers, Jay

Re: Automatically enter text in cell when due date in other cell is exceeded by 272 d

Hi Cytop, thanks very much for taking the time to reply. Sorry mate, I've not been as clear as i could have been. Typing is still required in the cell up until the 272 day cut off and if i put the formula directly in the cell it is overwitten. That is why i was trying to do it by using a conditional format, its just that it seems to have no effect. I can't think how else to proceed.

Any thoughts will be most welcome. Thanks for your time, regards, Jay

Hi All, I was hoping that someone might be able to help with the following issue. I want to enter the word 'Closed' in cell B1 when the due date in cell A1 is exceeded by 272 days. I have tried using conditional formatting and excel accepts the formula but nothing seems to happen. Here is what I have tried;

B1=IF(A1<=NOW()-272,"Closed")

Any help is greatly appreciated, Kind regards, Jay

Re: Check to see if 2 workbooks open and if yes exit sub

Hi Gents... Patel, HaHoBe & snb, thanks very much for taking the time to reply, I really appreciate the help.
HaHoBe, I wanted to exit the sub because I am trying to write info to other workbooks and there is a chance that another user may have them open. I am a vba amateur so be gentle

I have had a good play today with examples you all provided but snb's example was the only one I was able to manipulate to do as I wanted, probably down to lack of skill, ha. It isn't pretty but it seems to do what is required. Below is the finished macro that updates workbooks 2 & 3 with info from workbook 1. If either workbook 2 or 3 is already open then the user gets an alert.

Again, thank you all for your help.. Ozgrid rules, Jay

Private Sub Update_Click()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
'Confirmation of update response box
Dim Response As VbMsgBoxResult
Response = MsgBox("Confirm you want to write this information to the relevant workbook!", vbYesNo, "Are you sure?")
If Response = vbNo Then Exit Sub
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim wb2Paste As Range, wb3Paste As Range
Set wb1 = ThisWorkbook
'the sheet ref cannot ref to a cell with a non-numeric value
If Evaluate("isref('[Workbook2.xlsx]sheet1'!A1)") Then
MsgBox "One of the destination workbooks is already open. Please close it and try again!"
Exit Sub
End If
'the sheet ref cannot ref to a cell with a non-numeric value
If Evaluate("isref('[Workbook3.xlsx]sheet2'!A1)") Then
MsgBox "One of the destination workbooks is already open. Please close the destination workbooks and try again!"
Exit Sub
End If


Set wb2 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook2.xlsx")
Set wb3 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook3.xlsx")
With wb2.Sheets(2)
Set wb2Paste = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
'Copy Data from Wb1.Sheet1 to Wb2.sheet1
wb1.Sheets(1).Range("A8:I38").Copy
wb2Paste.PasteSpecial Paste:=xlPasteValues, Transpose:=False
Application.CutCopyMode = False
Set wb2Paste = Nothing
wb2.Close SaveChanges:=True
With wb3.Sheets(1)
Set wb3Paste = .Range("A985")
End With
'Copy Data from Wb1.Sheet2 to Wb3.sheet1
wb1.Sheets(2).Range("A8:L497").Copy
wb3Paste.PasteSpecial Paste:=xlPasteAll, Transpose:=False
Application.CutCopyMode = False
Set wb3Paste = Nothing
wb3.Close SaveChanges:=True
Set wb2 = Nothing
Set wb3 = Nothing
wb1.Sheets(1).Range("A8:I38").ClearContents
wb1.Save
MsgBox "The destination worksheets were successfully updated!"
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "An error has occurred. If the problem persists use the email button on the home page to report the issue!", vbOKOnly + vbCritical, "Error Message"


End Sub

Hi All, I was hoping someone might be able to help with the following issue. I enter info into workbook1 and then run a macro to update workbook2 and workbook3. The code below works fine in terms of the updating but I am struggling to find a way to handle the problems if workbook2 or workbook3 is open.

I was hoping to check if workbook2 or workbook3 is open and then simply exit the sub. Thank you in anticipation of any help that can be provided. Best regards, Jay.

Private Sub Update_Click()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
'Confirmation of update response box
Dim Response As VbMsgBoxResult
Response = MsgBox("Confirm you want to write this information to the relevant workbook!", vbYesNo, "Are you sure?")
If Response = vbNo Then Exit Sub
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim wb2Paste As Range, wb3Paste As Range
On Error Resume Next
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook 2.xls")
Set wb3 = Workbooks.Open(Filename:="C:\Users\Desktop\Workbook 3.xlsx")


If wb2.ReadOnly Then
MsgBox "Workbook 2 is already open. Please Try later!", vbCritical, "Workbook Open"
Exit Sub
End If
If wb3.ReadOnly Then
MsgBox "Workbook 3 is already open. Please Try later!", vbCritical, "Workbook Open"
Exit Sub
End If
 
With wb2.Sheets(2)
Set wb2Paste = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
'Copy Data from Wb1.Sheet1 to Wb2.sheet1
wb1.Sheets(1).Range("A8:I38").Copy
wb2Paste.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set wb2Paste = Nothing
wb2.Close SaveChanges:=True
wb1.Sheets(1).Range("A8:I38").ClearContents
With wb3.Sheets(1)
Set wb3Paste = .Range("A985")
End With
'Copy Data from Wb1.Sheet2 to Wb3.sheet1
wb1.Sheets(2).Range("A8:L497").Copy
wb3Paste.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set wb3Paste = Nothing
wb3.Close SaveChanges:=True
wb1.Save
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "An error has occurred. If the problem persists use the email button on the home page to report the issue!", vbOKOnly + vbCritical, "Error Message"


End Sub

Re: Change userform textbox backcolour if contents are a percentage

Hi Jindon, somehow i forgot to thank you for your assistance. Thanks, I really appreciate you taking the time to help.

Best regards, Jay

Re: Stop command buttons / textboxes from moving with cells

Hi SMC, thanks very much for taking the time to assist. I just realised i never responded to the above (how rude!).

Probably due to my enthusiastic incompetence I couldn't get the buttons to stop moving, however, since an upgrade from excel 2003 to 2010 the issue has resolved itself. I have no idea what the problem was.

Thank you again for taking the time out of your day to help.

Best regards, Jay

Re: Populate Single column Listbox from dynamic column data

Hi AAE & royUK, thanks very for taking the time to assist. Sorry about the delay in getting back, I had either manflu or the ebola virus, couldn't tell which

Yes royUK, the listbox is on a userform. After the advice given and a little more reading I came up with the following solution...

Private Sub CommandButton1_Click() Dim rngList As Range, sRngAddress As String
     
    With Sheet6
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter field:=1, Criteria1:="*" & txtCriteria.Value & "*", Operator:=xlAnd
        Set rngList = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        Sheet4.Cells.ClearContents
        rngList.Copy Sheet4.Range("A1")
        sRngAddress = "Sheet4!" & .Range("A1").CurrentRegion.Address
    End With
     
    With Sheet4
        ListBox1.List = Application.Transpose(.Range(.Range("A1"), .Range("A1").End(xlDown)).Value)
    End With
     
    Set rngList = Nothing
    
End Sub

With the code above i can now populate the listbox with the new dynamic range that is copied and pasted from the filtered rows on another sheet. Below is an example file showing population of a single column and a multi-column listbox. I'm sure guys out there could do it better but it is working for me.

Thanks again AAE, royUK and all at Ozgrid for taking the time to help.

Best regards, Jay

Hi All, i was hoping somebody may be able to spare some time to help with the following....

http://www.ozgrid.com/forum/showthread.php?t=172993

The thread above helped me to populate a multi-column Listbox by copying and pasting autofiltered rows to another sheet and using the newly pasted rows as a named range to populate the listbox. The code below works great...

Private Sub CommandButton1_Click()    Dim sCriteria As String, rngList As Range, sRngAddress As String
     
    sCriteria = Me.txtCriteria.Value
     
    With Sheet2
        .AutoFilterMode = False
        'below is set up to filter the values in the second coloumn only
        .Range("A1:F" & .Cells(Rows.Count, "B").End(xlUp).Row).AutoFilter field:=2, Criteria1:=sCriteria
        Set rngList = .Range("A1:F" & .Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        Sheet3.Cells.ClearContents
        rngList.Copy Sheet3.Range("A1")
        sRngAddress = "Sheet3!" & .Range("A1").CurrentRegion.Address
    End With
     
    With Me.ListBox1
        .RowSource = sRngAddress
    End With
     
    Set rngList = Nothing
     
End Sub

However, for a different application I have tried to ammend the code above to work with a single column listbox in the following way but keep getting an error at the line highlighted in red. the sheet is filtered and the filtered rows are pasted into a new sheet but the listbox won't pick up the sRngAddress...

Private Sub cmdAddressSearch_Click()
   Dim rngList As Range, sRngAddress As String
     
    With Sheet15
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter field:=1, Criteria1:="*" & txtCriteria.Value & "*", Operator:=xlAnd
        Set rngList = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        Sheet16.Cells.ClearContents
        rngList.Copy Sheet16.Range("A1")
        sRngAddress = "Sheet16!" & .Range("A1").CurrentRegion.Address
    End With
     
    With Me.ListBox1
        .RowSource = sRngAddress
    End With
     
    Set rngList = Nothing


End Sub

The error is...

Run-time error '380'.
Could not set the rowsource Property. Invalid Property Value.

If anyone has any thoughts on this i would be most grateful. Thanks in anticipation, best regards, Jay

Re: Search button on userform that allows a selection to populate textboxes on same f

Hi All, Using Roy's link above and doing a bit more reading on listboxes and vba advanced filters, I managed to get my 'find address' button working. Roy's link definately does what I asked in the title and I have posted an example back below of how I am actually using it now in case it might be useful to somebody. Thanks Roy and thanks to all those that share their time and knowledge so generously.

Best regards, Jay