Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all 49851 articles
Browse latest View live
↧

Function to Return Array of Unique Entries in a Range

April 17, 2014, 7:43 am
$
0
0
I have attached a spreadsheet with a UDF to identify unique entries in a range and return an array of only those uniques. However, the function does not work when passed a Named Range, defined by formula (See the Name Manager). It works fine when passed an explicit range reference or an explicitly defined Named Range.

I'm open to better solutions to the problem of returning an array of uniques from a list which may include duplicates. Ideally, any solution needs to be able to handle named ranges defined by formula.

I'm would really like help in fixing my function, improving the speed of my function, or an alternative approach which accomplishes the same thing.

Thank you
Attached Files
↧
Search

USERFORM to create new Book as a New report

April 17, 2014, 7:45 am
$
0
0
Hi I need help with this code: I have an Userform that shows when I click Button 1. This userform is created to be able to pull a report from the TAB: FIELDS. I do have problems getting the filter to work properly. The filter I need is in column B (Status) I need to be able to pull the report according with the code and save the new Book in a new file (Temp) if possible in a new FOLDER in the desktop. If anybody there can give me a hand... THANKS!! (see attached file)Test Financial Reporty.xlsm
↧
↧

Using Set - Object variable or With block variable not set error

April 17, 2014, 8:03 am
$
0
0
The code below gives the error: Run time error 91 - Object variable or With block variable not set

The problem occurs due to my use of Set.

The code aims to do the following:
If value in Column R = 1 (pw_tri sheet) and value in Col J (pw_tri sheet) < value found in Col B (controls sheet) tolerance, then value in Col T (pw_tri sheet) = 0, else value in Col T (pw_tri sheet) = value in Col S (pw_tri sheet)

What am i doing wrong?

Code:
Sub applyTolerance()
 
 Dim p As Integer
 Dim rng1 As Range
 Dim strSearch As String
 Dim tolerance As Integer
 
 For p = 2 To lastrowPW Step 1
 
  strSearch = Worksheets("PW_TRI").Range("A" & p).Value
  Set rng1 = Worksheets("Controls").Range("B:B").Find(strSearch, , xlValues, xlWhole)
  tolerance = rng1.Offset(0, 2)
 
  If Worksheets("PW_TRI").Range("R" & p).Value = 1 And Worksheets("PW_TRI").Range("J" & p).Value < tolerance Then
  Worksheets("PW_TRI").Range("T" & p).Value = 0
  Else: Worksheets("PW_TRI").Range("T" & p).Value = Worksheets("PW_TRI").Range("S" & p).Value
  End If
 
 Next p

End Sub
↧

Hide Column if to a Specific Cell/Value

April 17, 2014, 8:08 am
$
0
0
Hi all

In Cell B3 I've got a drop down menu (via data validation) with value A, B, C, D & ALL

In range D5 to AJ5 (currently, new columns will come) each cell is either A, B, C or D

What I would like the code to do is, whenever the user selects, let's say "B", to hide all columns not containing "B"
etc.
Likewise, when the user selects "ALL", none of the cols should be hidden.

I've tried to come up with an appoach, but this does not seem to work


Code:
Private Sub Worksheet_Change(ByVal Target As Range)l()

Dim c As Range

For Each c In Range("5:5")
    If c.Value <> Range("B3").Value Then .Column = Hidden
Next c
 
End Sub
Anyone who could help me out, perhaps?

Thanks

FD
↧

Disable sorting but allow filtering

April 17, 2014, 8:16 am
$
0
0
Hello everyone

I want to prevent sorting of columns in a single worksheet but allow filtering. I came across this macro for Excel 2003 in another forum but it doesn't seem to work for me (I'm using 2010). http://www.ozgrid.com/forum/showthread.php?t=49308

Formula: 
Sub Macro1() 

    ActiveSheet.EnableAutoFilter = True 

    ActiveSheet.Protect Scenarios:=True, contents:=True, userInterfaceOnly:=True 

End Sub


I entered it in the view code bit of the worksheet I want it applied to which I'm guessing is the right way to go about it?

Thanks
↧
↧

Problem with a TRIM macro

April 17, 2014, 8:20 am
$
0
0
Hi everyone,

I have the following macro:

Code:
Sub CleanSheetsMonth1()
Dim ws As Worksheet
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Sheets
        With ws.Range("P1:Y1998")
            On Error Resume Next
            .Value = Application.Trim(.Value)
            On Error GoTo 0
        End With
    Next ws
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub
In general this macro seemed to do what its supposed to do, being scanning the entire workbook within the cell range specifying and trimming leading/trailer spaces, but I've used it on another spreadsheet and its not TRIMing the cells correctly. The identified cells only contain letter values, there are no formulas associated with them. Any idea what I might be missing?

Thanks guys!
↧

Macro to Insert New Row and Update =Row() formula

April 17, 2014, 8:22 am
$
0
0
I have two data tables on a worksheet with Auto Numbering (1,2,3,…) in the first column.
I am using =Row() –<row#> to auto populate these numbers.
When I add a new row to the first table it throws the numbering sequence off in the second.
Is it possible to create a macro that will insert a new row in the first table and update the =Row-<row# +1> formula in the second table so both tables will be correct?
Attached Files
↧

How to open multiple files base on Range("A1:A" & Lr).Value???

April 17, 2014, 8:35 am
$
0
0
Hello All,
I'm looking for how to open multiple files base on the value of Range("A1:A" & Lr). Thank you for your help

Below is one I'm using for ForlderPicker but I'd like to select a certains file I want to

Code:
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
sDir = .SelectedItems(1)
End With

sFname = Dir(sDir & "\*.xls*")  ===>> Sheets("Sheet1").Range("A10:A12") & "\*.xls*")
Set thswbk = ThisWorkbook

Application.DisplayAlerts = False

Do While sFname <> ""
Regards,
tt3
↧
Search

Running a Macro on all the selected cells instead of just one.

April 17, 2014, 8:46 am
$
0
0
Hi Everyone,

First time poster. Just started using Macros on Excel.

I recorded a Macro that would take a value of a particular cell and add that value to the selected cell in the same row. However, this macro just runs on one cell and I want it to run on the entire row.

This may seem like a trivial issue but I've been racking my brain for the last couple of days to figure it out.

Here is the VBA code of the Macro I recorded. It adds the cell value to another cell with formulas already in it as you will see below:

Quote:
Sub SpreadingTest15()
'
' SpreadingTest15 Macro
'

'
ActiveCell.FormulaR1C1 = _
"=IF(MarRF!RC9=""Trade"",IFERROR(IF(RC12=""BL"",RC13/12,INDEX('Variable Data'!R4C2:R16C17,MATCH('1410-Rev'!RC14,'Variable Data'!R4C2:R16C2,0),MATCH('1410-Rev'!R14C,'Variable Data'!R4C2:R4C17,0))*RC13),0),IF(RC14=R14C,RC13,0))+(RC35)"
ActiveCell.Select
End Sub
Your help is greatly appreciated. Thank you in advance!
↧
↧

Apply Macro to specific worksheets in workbook

April 17, 2014, 8:48 am
$
0
0
Hi everyone,

I have a different question regarding this macro in another post, so I figured I'd put in a separate post for it. I have the following macro:

Code:
Sub CleanSheetsMonth1()
Dim ws As Worksheet
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Sheets
        With ws.Range("P1:Y1998")
            On Error Resume Next
            .Value = Application.Trim(.Value)
            On Error GoTo 0
        End With
    Next ws
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub
So right now the macro is run in every single worksheet in the workbook. Unfortunately, it appears the TRIM function erases formulas in cells. I want this macro to apply only to certain worksheets. Say the worksheets i want the macro to run on are named A1-A100. How could I apply this?

Thanks!!
↧

The code for sum in column 'an' not working

April 18, 2014, 5:14 am
$
0
0
Hi friends,
In my file the code for column 'an' is not working. It's a total marks. The code is in sheet1.

Regards,

Mukesh
Attached Files
↧

compile error expected line number statement end statement

April 18, 2014, 5:29 am
$
0
0
I am getting this error and where th If not starts its is in red showing that is where the issue is


HTML Code:
Sub RemoveRows()
Dim LR As Long, i As Long
Dim ws As Worksheet
Set ws = Worksheets("100 Airports")
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 10 Step -1

If Not(Range("B" & i).Value = Ws.Range("E4") or (Range("B" & i).Value = Ws.Range("E5") or (Range("B" & i).Value = Ws.Range("E6") or (Range("B" & i).Value = Ws.Range("E7") or (Range("B" & i).Value = Ws.Range("E8") or (Range("B" & i).Value = Ws.Range("E9") or (Range("B" & i).Value = Ws.Range("E10") or (Range("B" & i).Value = Ws.Range("E11") or (Range("B" & i).Value = Ws.Range("E12") or (Range("B" & i).Value = Ws.Range("E13") or (Range("B" & i).Value = Ws.Range("E14") or (Range("B" & i).Value = Ws.Range("E15") or (Range("B" & i).Value = Ws.Range("E16") or (Range("B" & i).Value = Ws.Range("E17") or (Range("B" & i).Value = Ws.Range("E18") or (Range("B" & i).Value = Ws.Range("E19") or (Range("B" & i).Value = Ws.Range("E20") or (Range("B" & i).Value = Ws.Range("E21") or (Range("B" & i).Value = Ws.Range("E22") or (Range("B" & i).Value = Ws.Range("E23") or (Range("B" & i).Value = Ws.Range("E24") or (Range("B" & i).Value = Ws.Range("E25") or (Range("B" & i).Value = Ws.Range("E26") or (Range("B" & i).Value = Ws.Range
("E27") or (Range("B" & i).Value = Ws.Range("E28") or (Range("B" & i).Value = Ws.Range("E29") or (Range("B" & i).Value = Ws.Range("E30") or (Range("B" & i).Value = Ws.Range("E31") or (Range("B" & i).Value = Ws.Range("E32") or (Range("B" & i).Value = Ws.Range("E33") or (Range("B" & i).Value = Ws.Range("E34") or (Range("B" & i).Value = Ws.Range("E35") or (Range("B" & i).Value = Ws.Range("E36") or (Range("B" & i).Value = Ws.Range("E37") or (Range("B" & i).Value = Ws.Range("E38") or (Range("B" & i).Value = Ws.Range("E39") or (Range("B" & i).Value = Ws.Range("E40") or (Range("B" & i).Value = Ws.Range("E41") or (Range("B" & i).Value = Ws.Range("E42") or (Range("B" & i).Value = Ws.Range("E43") or (Range("B" & i).Value = Ws.Range("E44") or (Range("B" & i).Value = Ws.Range("E45") or (Range("B" & i).Value = Ws.Range("E46") or (Range("B" & i).Value = Ws.Range("E47") or (Range("B" & i).Value = Ws.Range("E48") or (Range("B" & i).Value = Ws.Range("E49") or (Range("B" & i).Value = Ws.Range("E50") or (Range("B" & i).Value =
Ws.Range("E51") or (Range("B" & i).Value = Ws.Range("E52") or (Range("B" & i).Value = Ws.Range("E53") or (Range("B" & i).Value = Ws.Range("E54") or (Range("B" & i).Value = Ws.Range("E55") or (Range("B" & i).Value = Ws.Range("E56") or (Range("B" & i).Value = Ws.Range("E57") or (Range("B" & i).Value = Ws.Range("E58") or (Range("B" & i).Value = Ws.Range("E59") or (Range("B" & i).Value = Ws.Range("E60") or (Range("B" & i).Value = Ws.Range("E61") or (Range("B" & i).Value = Ws.Range("E62") or (Range("B" & i).Value = Ws.Range("E63") or (Range("B" & i).Value = Ws.Range("E64") or (Range("B" & i).Value = Ws.Range("E65") or (Range("B" & i).Value = Ws.Range("E66") or (Range("B" & i).Value = Ws.Range("E67") or (Range("B" & i).Value = Ws.Range("E68") or (Range("B" & i).Value = Ws.Range("E69") or (Range("B" & i).Value = Ws.Range("E70") or (Range("B" & i).Value = Ws.Range("E71") or (Range("B" & i).Value = Ws.Range("E72") or (Range("B" & i).Value = Ws.Range("E73") or (Range("B" & i).Value = Ws.Range("E74") or (Range("B" & i)
.Value = Ws.Range("E75") or (Range("B" & i).Value = Ws.Range("E76") or (Range("B" & i).Value = Ws.Range("E77") or (Range("B" & i).Value = Ws.Range("E78") or (Range("B" & i).Value = Ws.Range("E79") or (Range("B" & i).Value = Ws.Range("E80") or (Range("B" & i).Value = Ws.Range("E81") or (Range("B" & i).Value = Ws.Range("E82") or (Range("B" & i).Value = Ws.Range("E83") or (Range("B" & i).Value = Ws.Range("E84") or (Range("B" & i).Value = Ws.Range("E85") or (Range("B" & i).Value = Ws.Range("E86") or (Range("B" & i).Value = Ws.Range("E87") or (Range("B" & i).Value = Ws.Range("E88") or (Range("B" & i).Value = Ws.Range("E89") or (Range("B" & i).Value = Ws.Range("E90") or (Range("B" & i).Value = Ws.Range("E91") or (Range("B" & i).Value = Ws.Range("E92") or (Range("B" & i).Value = Ws.Range("E93") or (Range("B" & i).Value = Ws.Range("E94") or (Range("B" & i).Value = Ws.Range("E95") or (Range("B" & i).Value = Ws.Range("E96") or (Range("B" & i).Value = Ws.Range("E97") or (Range("B" & i).Value = Ws.Range("E98") or (Range
("B" & i).Value = Ws.Range("E99") or (Range("B" & i).Value = Ws.Range("E100") or (Range("B" & i).Value = Ws.Range("E101") or (Range("B" & i).Value = Ws.Range("E102") or (Range("B" & i).Value = Ws.Range("E103")) Then Rows(i).Delete
Next i
End Sub
↧

Open Form from another Form

April 18, 2014, 6:06 am
$
0
0
I want to open a Form from another Form. I have attached a simple example where I switch between 2 Forms. Is this the best way to open a Form from another Form? When I watch the stack window, number of items increases every time I open a new Form. It never decreases until I push Cancel in form 1. Does this cause an issue?

Why I am aking is that I have a huge project where Excel just throws me out of Excel without any warning. It only says Excel has stopped working. But it occurs when the code reaches the line "Unload Me". Maybe I am doing anything wrong when I call a Form from another Form.

Stack Window:
Stack Window.png

Example:
Open Form from another Form.xlsm
↧
↧

An FYI: Runtime Error 91 (Object variable not set)

April 18, 2014, 6:25 am
$
0
0
Hi,

I was at MSDN site reading about Runtime Error 91 because I am experiencing one and just couldn't see the obvious:

Here is my code where I am getting the error:

Code:
Private ClassInstance as ClassModule

Sub()
'codes....
ReturnValue = ClassInstance.ClassModuleFunction(ParameterA, ParameterB)
'codes....
End Sub
That code above throws me the Runtime 91 error.

Code:
Private ClassInstance as New ClassModule

Sub()
'codes....
ReturnValue = ClassInstance.ClassModuleFunction(ParameterA, ParameterB)
'codes....
End Sub
It took me some time to figure out my self what my 'miss' was, and I felt stupid after I did.

I wanted to share that experience at the link I provided but there is no facility for that in there, so instead I posted this thread to share to anyone who might stumble upon my post!
↧

[SOLVED] Code was working perfectly, but now will not work after an error window popped up...

April 18, 2014, 6:29 am
$
0
0
Hi,

I have a code entered into THISWORKBOOK as a sheetchange. The code enables two-way cell linking, which I manipulated to basically perform three-way cell linking. It was working perfectly for a few days, but then an error popped up and the options were to "end" or "debug." Now I cannot get the code to work again. I am not sure what happened as it was working perfectly...
The following is the code I am using:
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    Sheet2.Range("D" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("D:D")) Is Nothing Then
    Sheet1.Range("A" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    Sheet2.Range("D" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
    Sheet2.Range("E" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
    Sheet1.Range("B" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("D:D")) Is Nothing Then
    Sheet2.Range("A" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    Sheet1.Range("D" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
    Sheet2.Range("B" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
    Sheet1.Range("E" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("F:F")) Is Nothing Then
    Sheet2.Range("F" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("F:F")) Is Nothing Then
    Sheet1.Range("F" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("H:H")) Is Nothing Then
    Sheet2.Range("C" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
    Sheet1.Range("H" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("I:I")) Is Nothing Then
    Sheet2.Range("G" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("G:G")) Is Nothing Then
    Sheet1.Range("I" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("J:J")) Is Nothing Then
    Sheet2.Range("H" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("H:H")) Is Nothing Then
    Sheet1.Range("J" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("K:K")) Is Nothing Then
    Sheet2.Range("T" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("T:T")) Is Nothing Then
    Sheet1.Range("K" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("L:L")) Is Nothing Then
    Sheet2.Range("T" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("U:U")) Is Nothing Then
    Sheet1.Range("U" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("N:N")) Is Nothing Then
    Sheet2.Range("N" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("N:N")) Is Nothing Then
    Sheet1.Range("N" & Target.Row).Value = Target.Value
End If
If Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    Sheet1.Range("A" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    Sheet3.Range("A" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    Sheet1.Range("A" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
    Sheet3.Range("B" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
    Sheet1.Range("B" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
    Sheet3.Range("C" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
    Sheet1.Range("C" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("F:F")) Is Nothing Then
    Sheet3.Range("D" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("D:D")) Is Nothing Then
    Sheet1.Range("F" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("G:G")) Is Nothing Then
    Sheet3.Range("E" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
    Sheet1.Range("G" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("I:I")) Is Nothing Then
    Sheet3.Range("P" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("P:P")) Is Nothing Then
    Sheet1.Range("I" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("K:K")) Is Nothing Then
    Sheet3.Range("Q" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("Q:Q")) Is Nothing Then
    Sheet1.Range("K" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("M:M")) Is Nothing Then
    Sheet3.Range("N" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("N:N")) Is Nothing Then
    Sheet1.Range("M" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet1" And Not Application.Intersect(Target, Range("L:L")) Is Nothing Then
    Sheet3.Range("R" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("R:R")) Is Nothing Then
    Sheet1.Range("L" & Target.Row).Value = Target.Value
End If
If Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("D:D")) Is Nothing Then
    Sheet3.Range("A" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("D:D")) Is Nothing Then
    Sheet3.Range("A" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    Sheet2.Range("D" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
    Sheet3.Range("B" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
    Sheet2.Range("E" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("F:F")) Is Nothing Then
    Sheet3.Range("D" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("D:D")) Is Nothing Then
    Sheet2.Range("F" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("G:G")) Is Nothing Then
    Sheet3.Range("P" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("P:P")) Is Nothing Then
    Sheet2.Range("G" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("I:I")) Is Nothing Then
    Sheet3.Range("I" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("I:I")) Is Nothing Then
    Sheet2.Range("I" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("J:J")) Is Nothing Then
    Sheet3.Range("J" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("J:J")) Is Nothing Then
    Sheet2.Range("J" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("K:K")) Is Nothing Then
    Sheet3.Range("K" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("K:K")) Is Nothing Then
    Sheet2.Range("K" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("L:L")) Is Nothing Then
    Sheet3.Range("L" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("L:L")) Is Nothing Then
    Sheet2.Range("L" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("S:S")) Is Nothing Then
    Sheet3.Range("O" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("O:O")) Is Nothing Then
    Sheet2.Range("S" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("T:T")) Is Nothing Then
    Sheet3.Range("Q" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("Q:Q")) Is Nothing Then
    Sheet2.Range("T" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet2" And Not Application.Intersect(Target, Range("U:U")) Is Nothing Then
    Sheet3.Range("R" & Target.Row).Value = Target.Value
ElseIf Sh.CodeName = "Sheet3" And Not Application.Intersect(Target, Range("R:R")) Is Nothing Then
    Sheet2.Range("U" & Target.Row).Value = Target.Value
End If
Application.EnableEvents = True
End Sub
Any help would be much appreciated!
↧
Search

Vba code working in workbook module but not working from personal.xlb

April 18, 2014, 6:44 am
$
0
0
Dear Members,

Below VBA code copies certain columns in to active workbook from file after selecting . Code works perfect there (In workbook module). If I kept this code in personal.xlb, It is giving Run-time error'9':Subscript out of range see red line where error comes.

Code:
'*************************************************************************************************
'* To Import THC Data From Downloaded File                                                      *
'*************************************************************************************************


Sub CopyDataForFtlReport()
   
    'Declare variables
   
    Dim fileDialog      As fileDialog
    Dim strPathFile    As String
    Dim strFileName    As String
    Dim strPath        As String
    Dim dialogTitle    As String
    Dim wbSource        As Workbook
    Dim wbmain          As Workbook
    Dim rngToCopy      As Range
    Dim rngRow          As Range
    Dim rngDestin      As Range
    Dim lngRowsCopied  As Long
   
    'Creat path of source workbook
   
    dialogTitle = "Select Required File to Import THC Data. (Nandkumar Satpute 9763616997)"
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    With fileDialog
        .InitialFileName = "C:\Users\User\Documents\downloads"
        .AllowMultiSelect = False
        .Filters.Clear
        .Title = dialogTitle
        .Filters.Add "Excel Files", "*.xls"
        If .Show = False Then
            MsgBox "File not selected to import. Process Terminated"
            Exit Sub
        End If
        strPathFile = .SelectedItems(1)
    End With
    Application.ScreenUpdating = False
   
    'Set selected workbook as wbSource
   
    Set wbSource = Workbooks.Open(Filename:=strPathFile)
    ThisWorkbook.Sheets("THC").Activate ' Here error giving
   

    'Copy data from wbsource workbook to Thc Sheet of Active workbook
   
    With wbSource.Worksheets("Sheet")
        Dim lRwc As Long: lRwc = .Cells(Rows.Count, "A").End(xlUp).Row
        Dim lRwP As Long: lRwP = Range("A" & Rows.Count).End(xlUp).Row + 1
       
        .Range("A1:A" & lRwc).SpecialCells(xlCellTypeVisible).Copy Range("A" & lRwP)
        .Range("B1:B" & lRwc).SpecialCells(xlCellTypeVisible).Copy Range("B" & lRwP)
        .Range("C1:C" & lRwc).SpecialCells(xlCellTypeVisible).Copy Range("C" & lRwP)
        .Range("N1:N" & lRwc).SpecialCells(xlCellTypeVisible).Copy Range("D" & lRwP)
        .Range("P1:P" & lRwc).SpecialCells(xlCellTypeVisible).Copy Range("E" & lRwP)
        .Range("Q1:Q" & lRwc).SpecialCells(xlCellTypeVisible).Copy Range("F" & lRwP)
        .Range("E1:E" & lRwc).SpecialCells(xlCellTypeVisible).Copy Range("G" & lRwP)
        .Range("F1:F" & lRwc).SpecialCells(xlCellTypeVisible).Copy Range("H" & lRwP)
       
        'Counting number of rows copied to 'THC' Sheet of active workbook
       
        lDiff = Range("A" & Rows.Count).End(xlUp).Row
    End With
   
    'Change Font
   
    ThisWorkbook.Sheets("THC").Activate
    Cells.Select
    With Selection.Font
      .Name = "Verdana"
      .Size = 8
    End With
   
    'Close Source workbook without saving
   
    ThisWorkbook.Sheets("sheet1").Activate
    wbSource.Close SaveChanges:=False
    Application.ScreenUpdating = True
   
    'source workbook have extra two rows which should minus from counting
   
    lngRowsCopied = lngRowsCopied - 2
   
    'Below macro removes duplicate from 'THC' Sheet
   
    Call DuplicateThc
    MsgBox lDiff - lRwP & " THC Records Copied."
    ThisWorkbook.Sheets("sheet1").Activate
   
    'Set value to nothing
   
    Set fileDialog = Nothing
    Set rngRow = Nothing
    Set rngToCopy = Nothing
    Set wbSource = Nothing
    Set rngDestin = Nothing
   
End Sub
↧

VB Code required to move macro to next row down cell

April 18, 2014, 7:00 am
$
0
0
I have 'sheet 1' (data collection sheet) and 'sheet 2' (form filling sheet)

I've recorded a macro which sends data from 'sheet 2' to 'sheet 1' (linked to a submit button on 'sheet 2')

I want the macro to allow the next form filled information to be transferred onto the next line down on 'sheet 1'.

The current code is:

Code:
Sub Macro4()
'
' Macro4 Macro
'

'
    Sheets("Sheet2").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=Sheet3!R[-1]C[1]"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=Sheet3!RC"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=Sheet3!R[1]C[-1]"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=Sheet3!R[2]C[-2]"
    Range("D3").Select
    Sheets("Sheet3").Select
End Sub
Thanks,
Jack
↧
↧

copy duplicate data (paste some specific columns)

April 18, 2014, 7:06 am
$
0
0
Hi.
I need copy duplicate data to anothe sheet, but paste only column(1,2,4,5,6,13,14)
Code:
Option Explicit

Sub Macro1()
'Author:Trebor76
''http://www.mrexcel.com/forum/showthread.php?t=632244
    Dim wstSource As Worksheet, _
        wstOutput As Worksheet
    Dim rngCell As Range, _
        rngMyData As Range
    Dim lngMyRow As Long
   
    Set wstSource = Worksheets("Orig")
    Set wstOutput = Worksheets("Dest")
    Set rngMyData = wstSource.Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
   
    Application.ScreenUpdating = False
   
    For Each rngCell In rngMyData
        If Evaluate("COUNTIF(" & rngMyData.Address & "," & rngCell.Address & ")") > 1 Then
            lngMyRow = wstOutput.Cells(Rows.Count, "A").End(xlUp).Row + 1
            wstSource.Range("A" & rngCell.Row & ":N" & rngCell.Row).Copy _
                Destination:=wstOutput.Range("A" & lngMyRow & ":N" & lngMyRow)
                'How to copy only column(1,2,4,5,6,13,14)?


        End If
    Next rngCell
   
    Application.ScreenUpdating = True


End Sub
Cross-Post
http://www.mrexcel.com/forum/excel-q...c-columns.html
Thanks
↧

Delete empty rows macro

April 18, 2014, 7:14 am
$
0
0
I have a formula that does exactly what
I need , it fetches negative stocks from
sheet 1 , but the formula places the data
exactly on the same row where the negative
is , thus there are a lot of in between data not
required , Yes I can copy paste special values
and remove blank rows , but the macro will do
it faster
↧

Interpolation between values and return them to excel sheet (using VBA)

April 18, 2014, 7:30 am
$
0
0
Hi all,

I am looking for a VBA code which can be used to interpolate between values at a given interval and return these values to an excel sheet.
I have a list with X and Y values and need to interpolate (linear) between two X points to return intermediate values for Y (interval between values is defined by the user in a userform).
The code is to continue with interpolation between two consecutive X points until it has reached the end of the listing. In the example only several points are given, but the list can be longer or shorter than given in the example.
The results need to be returned to a new sheet.

Can someone help me with this?

Regards,
Martijn

Test4.xlsx
↧
Viewing all 49851 articles
Browse latest View live
Search