Posts by the Okk

Re: Getting The Cell Index For A Function Not The Cells Value

Quote from nb-

Code

Option Explicit
'// Test Function
Public Function testfunction(targetcell As Variant, par1 As Integer, par2 As Integer) As Double
Dim row%, column%


row= ???????????????.targetcell
'//Equivalent of =row(targetcell)
column = ??????????????.targetcell
'//Equivalent of =column(targetcell)




testfunction = Cells(row, column) / (Cells(row - par1, column) + Cells(row + par2, column))


End Function

Display More

It Looks like simple formula:
=A1/(OFFSET(A1,-par1)+OFFSET(A1,par2))
Are you sure you need UDF?

Re: Use Of Conditional Format For More Cells

Quote from diku

But on same condition (D8=0) I like to make all column D with red Pattern Background.
How is that possible?

Select Range you want to format. Menu bar -> Format -> Conditional Formatting. Use Formula: =NOT($D$8)

Re: Find Value, Select Value In Another Column, Then Paste That Value

Use VLOOKUP functions.

Re: Number Of Rows In A Range After Filter

Quote from Scottintexas

I have applied a filter to my worksheet and would like to know if there is a way to get the number of rows included in the resulting filtered data.

Code

Worksheets("All Work").Select
    iCount = GetEnd(Worksheets("All Work"))
    Set Cell1 = Cells(2, 1)
    Set Cell2 = Cells(iCount, 6)
    Worksheets("All Work").Range(Cell1, Cell2).AutoFilter Field:=7, Criteria1:="Unassigned"

Now that I have it filtered I need to know how many rows are there with data.

You need to count visible Rows of your range? Then:

lngVisibleRowsCount = Worksheets("All Work").Range(Cell1,Cells(icount,1)).SpecialCells(xlCellTypeVisible).Cells.Count

Re: Error In Finding Date In Another Range

Quote from tardy

HiHi theOkk

Went out of office yesterday...

ok that kinda works but i need to change the date format from 4-digit years (dd/mm/yyyy) to 2-digit years (dd/mm/yy) instead... Have you any idea how to do that?

Or is there another method to specify the macro to look for the value of C1 in terms of serial value?

Display More

Can you give us an example of your file?

Re: Error In Finding Date In Another Range

Quote from tardy

Is there a way for the macro to pickup this date format instead of the string/formula in C1?

Something like that?:

Sub sdata()
Dim s1, s2 As Worksheet
Dim tdy As Range
Dim today As Long
 
Set s2 = Sheets(2)


today = Sheets(1).Range("C1")


Set tdy = s2.Range("A1:A65536").Find(CDate(today))
If Not tdy Is Nothing Then Application.Goto tdy
End Sub

Re: Error In Finding Date In Another Range

Quote from tardy

Is there a way for the macro to pickup this date format instead of the string/formula in C1?

Have you tried:

Dim today As Date

?
What exactly you want to find? TODAY()? Or WORKDAY?

Re: Error In Finding Date In Another Range

Dim s1, s2 as worksheet
dim tdy as range
Dim today as long


set s1 = sheets("Sheet1")
set s2 = sheets("Sheet2")


today = s1.range("C1")


Set tdy = s2.range("A1:A65536").find(today, lookin:=xlvalues)
If Not tdy is Nothing then tdy.Activate

Re: Getting Data From Worksheet To Another

Quote from aliosman

how did you do it please?

thank you

http://www.cpearson.com/excel/named.htm

Re: Getting Data From Worksheet To Another

Quote from aliosman

hi

i want to filter data from worksheet to another. i want to display specific data by getting the file from other worksheet

please look at the attachment i explained the problem.

thank you

Display More

Create a named range with ID's

Re: Populating The Last Cell In A Range From A TextBox

Private Sub AddButton1_Click()


Sheets("Data").Cells(Rows.Count,1).End(xlUp).Offset(1)=TextBox3.Value
End Sub

?

Re: Accessing Isblank In Vba

Quote from Om Avataar

Is the following valid code in Excel VBA?

Code

If Application.WorksheetFunction.isblank(Cells(RowIndex, ColIndex)) Then

Thanks

Do you use some Loop? The best way for it:

For each EmptyCell in YourRange.SpecialCells(xlCellTypeBlanks)
Next EmptyCell

or

For each NonEmptyCell in YourRange.SpecialCells(xlCellTypeConstants)
Next NonEmptyCell

Or you can Access to IsBlank function by:

If Evaluate("Isblank(" & Cells(RowIndex, ColIndex).address & ")") Then

But I suggest you to use SpecialCells method if it's possible.

Re: Run-time Error 2147352571(8002005).

Quote from pjcw

The error is displayed as a "Type Mismatch", but not the usual error number of 13.

Then try:

cbxCaseType.Clear 
cbxCaseType.AddItem "Blank" 
Application.ScreenUpdating = False 
Dim cell As range 
For Each cell In Worksheets("Index").Columns(1). _
  Resize(Rows.count-1).Offset(1). _
  SpecialCells(xlCellTypeConstants) 
    cbxCaseType.AddItem CStr(Cell.value)
Next Cell
TP.Activate

Re: Run-time Error 2147352571(8002005).

Quote from pjcw

I have an Excel system containing VBA code and forms. A combobox, whose list is created within the VBA code works throughout the UK without problems, but when sent to a user in France, gets the above error. The code is below.

Code

Top:
    If Cells(N, 1) = "" Then GoTo Done
    cbxCaseType.AddItem Cells(N, 1)   ' This line causes the error in France
    N = N + 1
    GoTo Top
Done:

Dim cell As range
For each cell in Columns(1).Resize(Rows.count-1).Offset(1). _
SpecialCells(xlCellTypeConstants)
cbxCaseType.AddItem Cell.value
Next Cell

What type of error? Are there some description?

Re: Search For A String. Then Copy All Cells Between Each Occurrence

Quote from khalel04

Hi Jindon/the OKK,

Both script you made, it just copied the whole data into column B.

Try this one:

Sub FilterToRange() 
    Dim xlInitialCalcState As XlCalculation 
    Dim rngCrit As Range, rngResult As Range 
    Dim lngLastRow As Long, lngColCount As Long 
     
    With Application 
        .ScreenUpdating = False 
        xlInitialCalcState = .Calculation 
        .Calculation = xlCalculationManual 
         
        lngColCount = ActiveSheet.UsedRange.Columns.Count 
         
        Set rngCrit = Cells(1, lngColCount + 2).Resize(2) 
        rngCrit(1).Value = Cells(1, 1).Value 
        rngCrit(2).Value = "<>" & rngCrit(1).Value
         
        Set rngResult = Cells(1, lngColCount + 1) 
         
        Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter _ 
        Action:=xlFilterCopy, _ 
        CriteriaRange:=rngCrit, _ 
        CopyToRange:=rngResult 
         
        rngCrit.ClearContents 
        rngResult(1).Delete 
         
        .Calculation = xlInitialCalcState 
        .ScreenUpdating = True 
    End With 
End Sub

Re: Search For A String. Then Copy All Cells Between Each Occurrence

You can use Advanced Filter to copy filtered values to another place. This macro can do it for you:

Sub FilterToRange()
    Dim xlInitialCalcState As XlCalculation
    Dim rngCrit As Range, rngResult As Range
    Dim lngLastRow As Long, lngColCount As Long


    With Application
        .ScreenUpdating = False
        xlInitialCalcState = .Calculation
        .Calculation = xlCalculationManual


        lngColCount = ActiveSheet.UsedRange.Columns.Count


        Set rngCrit = Cells(1, lngColCount + 2).Resize(2)
        rngCrit(1).Value = Cells(1, 1).Value
        rngCrit(2).Value = "<>spot.return"


        Set rngResult = Cells(1, lngColCount + 1)


        Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter _
                Action:=xlFilterCopy, _
                CriteriaRange:=rngCrit, _
                CopyToRange:=rngResult


        rngCrit.ClearContents
        rngResult(1).Delete


        .Calculation = xlInitialCalcState
        .ScreenUpdating = True
    End With
End Sub

Re: Search For A String. Then Copy All Cells Between Each Occurence

This code will select all numeric cells in 1-st column:

Columns(1).SpecialCells(xlCellTypeConstants,xlNumbers).Select

Re: Select Last Cell And Fill Down

Worksheets("CD").Cells(Rows.Count,1).End(xlUp).Offset(1).FillDown

?
or

Worksheets("CD").Cells(Rows.Count,1).End(xlUp).Resize(2).FillDown

?

Re: Speed Up For Each Cell Code

Quote from royUK

Why select?

Code

Sub make_neg()
    Dim rng    As Range
    Dim cl     As Range


    With Workbooks("Great_Plains_Budget.xls")
        'specify correct sheet
        Set rng = Worksheets(1).Range(Cells(4, 1), Cells(Rows.Count).End(xlUp))
        For Each cl In rng
            If cl.Offset(0, 1).Value > 5000 Then cl.Value = cl.Value * -1
        Next cl
    End With
End Sub

Display More

Why Loop?

Sub MySub()
    Dim xlInitialCalcState As XlCalculation
    Dim rng As Range
    Dim address(0 To 1) As String


    With Application
        .ScreenUpdating = False
        xlInitialCalcState = .Calculation
        .Calculation = xlCalculationManual




        Set rng = Workbooks("Great_Plains_Budget.xls").Worksheets(1) _
                  .Range(Cells(6, 4), Cells(Rows.Count, 4).End(xlUp)) _
                  .SpecialCells(xlCellTypeConstants)
        With rng
            address(0) = .offset(,-2).address
            address(1) = .address
            .Value = Evaluate("=IF(" & address(0) & ">5000, -1*" & address(1) & "," & address(1) & ")")
        End With


        .Calculation = xlInitialCalcState
        .ScreenUpdating = True
    End With
End Sub

Re: Create Range Box On Form

Quote from shg

Can someone tell me how to create a 'range box' on a form that allows you to drag and select a range, like a type 8 InputBox?

Thanks in advance,

Microsoft Office Spreadsheet Control